From 4c186c20b9a5a3a95768d9a609c93df37991c663 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 6 Nov 2021 23:18:19 -0700 Subject: [PATCH 001/244] Post-release CHANGELOG update --- CHANGELOG.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9118671..f65bbfa 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## Git +### Added + +### Fixed + +### Changed + + ## v0.8.0 - 2021-11-06 ### Added - `disable=all` now conveniently disables all warnings From c5de58ae84954b1c773bfe2b3710daf0d7e92fbd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ville=20Skytt=C3=A4?= Date: Sat, 13 Nov 2021 12:50:53 +0200 Subject: [PATCH 002/244] Comment spelling fixes --- src/ShellCheck/AnalyzerLib.hs | 2 +- src/ShellCheck/Checks/Commands.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 687859f..5f77fba 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -351,7 +351,7 @@ isQuoteFreeNode strict shell tree t = T_SelectIn {} -> return (not strict) _ -> Nothing - -- Check whether this assigment is self-quoting due to being a recognized + -- Check whether this assignment is self-quoting due to being a recognized -- assignment passed to a Declaration Utility. This will soon be required -- by POSIX: https://austingroupbugs.net/view.php?id=351 assignmentIsQuoting t = shellParsesParamsAsAssignments || not (isAssignmentParamToCommand t) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 5a29a26..1a48a28 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -735,7 +735,7 @@ getPrintfFormats = getFormats -- \____ _____/\___ ____/ \____ ____/\_________ _________/ \______ / -- V V V V V -- flags field width precision format character rest - -- field width and precision can be specified with a '*' instead of a digit, + -- field width and precision can be specified with an '*' instead of a digit, -- in which case printf will accept one more argument for each '*' used From d9a9d5db86122d608b1a6929609e799d175e6aa6 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 14 Nov 2021 16:39:32 -0800 Subject: [PATCH 003/244] Mark prefix/postfix inc/dec as integers (fixes #2376) --- src/ShellCheck/Analytics.hs | 3 ++- src/ShellCheck/AnalyzerLib.hs | 8 +++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 652c2fb..188d683 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2049,6 +2049,8 @@ prop_checkSpacefulness43= verifyNotTree checkSpacefulness "$foo=42" prop_checkSpacefulness44= verifyTree checkSpacefulness "#!/bin/sh\nexport var=$value" prop_checkSpacefulness45= verifyNotTree checkSpacefulness "wait -zzx -p foo; echo $foo" prop_checkSpacefulness46= verifyNotTree checkSpacefulness "x=0; (( x += 1 )); echo $x" +prop_checkSpacefulness47= verifyNotTree checkSpacefulness "x=0; (( x-- )); echo $x" +prop_checkSpacefulness48= verifyNotTree checkSpacefulness "x=0; (( ++x )); echo $x" data SpaceStatus = SpaceSome | SpaceNone | SpaceEmpty deriving (Eq) instance Semigroup SpaceStatus where @@ -2139,7 +2141,6 @@ checkSpacefulness' onFind params t = where emit x = tell [x] - writeF _ (TA_Assignment {}) name _ = setSpaces name SpaceNone >> return [] writeF _ _ name (DataString SourceExternal) = setSpaces name SpaceSome >> return [] writeF _ _ name (DataString SourceInteger) = setSpaces name SpaceNone >> return [] diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 687859f..9b53f9f 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -511,13 +511,11 @@ getModifiedVariables t = T_SimpleCommand {} -> getModifiedVariableCommand t - TA_Unary _ "++|" v@(TA_Variable _ name _) -> - [(t, v, name, DataString $ SourceFrom [v])] - TA_Unary _ "|++" v@(TA_Variable _ name _) -> - [(t, v, name, DataString $ SourceFrom [v])] + TA_Unary _ op v@(TA_Variable _ name _) | "--" `isInfixOf` op || "++" `isInfixOf` op -> + [(t, v, name, DataString SourceInteger)] TA_Assignment _ op (TA_Variable _ name _) rhs -> do guard $ op `elem` ["=", "*=", "/=", "%=", "+=", "-=", "<<=", ">>=", "&=", "^=", "|="] - return (t, t, name, DataString $ SourceFrom [rhs]) + return (t, t, name, DataString SourceInteger) T_BatsTest {} -> [ (t, t, "lines", DataArray SourceExternal), From 499c99372eaef411fc5223393c6799005eebc085 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 14 Nov 2021 21:34:21 -0800 Subject: [PATCH 004/244] Rewrite SC2032 warning and mention line number (fixes #2353) --- src/ShellCheck/Analytics.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 188d683..4a7f364 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2297,7 +2297,7 @@ checkFunctionsUsedExternally params t = let args = skipOver t argv let argStrings = map (\x -> (fromMaybe "" $ getLiteralString x, x)) args let candidates = getPotentialCommands name argStrings - mapM_ (checkArg name) candidates + mapM_ (checkArg name (getId t)) candidates _ -> return () checkCommand _ _ = return () @@ -2323,14 +2323,19 @@ checkFunctionsUsedExternally params t = functionsAndAliases = Map.union (functions t) (aliases t) - checkArg cmd (_, arg) = sequence_ $ do + patternContext id = + case posLine . fst <$> Map.lookup id (tokenPositions params) of + Just l -> " on line " <> show l <> "." + _ -> "." + + checkArg cmd cmdId (_, arg) = sequence_ $ do literalArg <- getUnquotedLiteral arg -- only consider unquoted literals definitionId <- Map.lookup literalArg functionsAndAliases return $ do warn (getId arg) 2033 - "Shell functions can't be passed to external commands." + "Shell functions can't be passed to external commands. Use separate script or sh -c." info definitionId 2032 $ - "Use own script or sh -c '..' to run this from " ++ cmd ++ "." + "This function can't be invoked via " ++ cmd ++ patternContext cmdId prop_checkUnused0 = verifyNotTree checkUnusedAssignments "var=foo; echo $var" prop_checkUnused1 = verifyTree checkUnusedAssignments "var=foo; echo $bar" From 9092080a84af694f1a1fbc1d59f89d296f362069 Mon Sep 17 00:00:00 2001 From: Martin Schulze Date: Mon, 15 Nov 2021 11:49:36 +0100 Subject: [PATCH 005/244] bats: Add check for useless negation (SC2314/15) --- src/ShellCheck/Analytics.hs | 43 +++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 4a7f364..7c31137 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -199,6 +199,7 @@ nodeChecks = [ ,checkComparisonWithLeadingX ,checkCommandWithTrailingSymbol ,checkUnquotedParameterExpansionPattern + ,checkBatsTestDoesNotUseNegation ] optionalChecks = map fst optionalTreeChecks @@ -4863,5 +4864,47 @@ checkExtraMaskedReturns params t = runNodeAnalysis findMaskingNodes params t hasParent pred t = any (uncurry pred) (parentChildPairs t) +-- hard error on negated command that is not last +prop_checkBatsTestDoesNotUseNegation1 = verify checkBatsTestDoesNotUseNegation "#!/usr/bin/env/bats\n@test \"name\" { ! true; false; }" +prop_checkBatsTestDoesNotUseNegation2 = verify checkBatsTestDoesNotUseNegation "#!/usr/bin/env/bats\n@test \"name\" { ! [[ -e test ]]; false; }" +prop_checkBatsTestDoesNotUseNegation3 = verify checkBatsTestDoesNotUseNegation "#!/usr/bin/env/bats\n@test \"name\" { ! [ -e test ]; false; }" +-- acceptable formats: +-- using run +prop_checkBatsTestDoesNotUseNegation4 = verifyNot checkBatsTestDoesNotUseNegation "#!/usr/bin/env/bats\n@test \"name\" { run ! true; }" +-- using || false +prop_checkBatsTestDoesNotUseNegation5 = verifyNot checkBatsTestDoesNotUseNegation "#!/usr/bin/env/bats\n@test \"name\" { ! [[ -e test ]] || false; }" +prop_checkBatsTestDoesNotUseNegation6 = verifyNot checkBatsTestDoesNotUseNegation "#!/usr/bin/env/bats\n@test \"name\" { ! [ -e test ] || false; }" +-- only style warning when last command +prop_checkBatsTestDoesNotUseNegation7 = verifyCodes checkBatsTestDoesNotUseNegation [2314] "#!/usr/bin/env/bats\n@test \"name\" { ! true; }" +prop_checkBatsTestDoesNotUseNegation8 = verifyCodes checkBatsTestDoesNotUseNegation [2315] "#!/usr/bin/env/bats\n@test \"name\" { ! [[ -e test ]]; }" +prop_checkBatsTestDoesNotUseNegation9 = verifyCodes checkBatsTestDoesNotUseNegation [2315] "#!/usr/bin/env/bats\n@test \"name\" { ! [ -e test ]; }" + +checkBatsTestDoesNotUseNegation params t = + case t of + T_BatsTest _ _ (T_BraceGroup _ commands) -> mapM_ (check commands) commands + _ -> return () + where + check commands t = + case t of + T_Banged id (T_Pipeline _ _ [T_Redirecting _ _ (T_Condition idCondition _ _)]) -> + if t `isLastOf` commands + then style id 2315 "In Bats, ! will not fail the test if it is not the last command anymore. Fold the `!` into the conditional!" + else err id 2315 + "In Bats, ! does not cause a test failure. Fold the `!` into the conditional!" + + T_Banged id cmd -> if t `isLastOf` commands + then styleWithFix id 2314 + "In Bats, ! will not fail the test if it is not the last command anymore. Use `run ! ` (on Bats >= 1.5.0) instead." + (fixWith [replaceStart id params 0 "run "]) + else errWithFix id 2314 + "In Bats, ! does not cause a test failure. Use 'run ! ' (on Bats >= 1.5.0) instead." + (fixWith [replaceStart id params 0 "run "]) + _ -> return () + isLastOf t commands = + case commands of + [x] -> x == t + x:rest -> isLastOf t rest + [] -> False + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) From d7971dafd1539de37bb29cb554d5fd4f4b95553b Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 Dec 2021 17:37:12 -0800 Subject: [PATCH 006/244] Minor formatting fixes --- src/ShellCheck/Analytics.hs | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 7c31137..d48104e 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4868,7 +4868,7 @@ checkExtraMaskedReturns params t = runNodeAnalysis findMaskingNodes params t prop_checkBatsTestDoesNotUseNegation1 = verify checkBatsTestDoesNotUseNegation "#!/usr/bin/env/bats\n@test \"name\" { ! true; false; }" prop_checkBatsTestDoesNotUseNegation2 = verify checkBatsTestDoesNotUseNegation "#!/usr/bin/env/bats\n@test \"name\" { ! [[ -e test ]]; false; }" prop_checkBatsTestDoesNotUseNegation3 = verify checkBatsTestDoesNotUseNegation "#!/usr/bin/env/bats\n@test \"name\" { ! [ -e test ]; false; }" --- acceptable formats: +-- acceptable formats: -- using run prop_checkBatsTestDoesNotUseNegation4 = verifyNot checkBatsTestDoesNotUseNegation "#!/usr/bin/env/bats\n@test \"name\" { run ! true; }" -- using || false @@ -4886,21 +4886,18 @@ checkBatsTestDoesNotUseNegation params t = where check commands t = case t of - T_Banged id (T_Pipeline _ _ [T_Redirecting _ _ (T_Condition idCondition _ _)]) -> + T_Banged id (T_Pipeline _ _ [T_Redirecting _ _ (T_Condition idCondition _ _)]) -> if t `isLastOf` commands then style id 2315 "In Bats, ! will not fail the test if it is not the last command anymore. Fold the `!` into the conditional!" - else err id 2315 - "In Bats, ! does not cause a test failure. Fold the `!` into the conditional!" - + else err id 2315 "In Bats, ! does not cause a test failure. Fold the `!` into the conditional!" + T_Banged id cmd -> if t `isLastOf` commands - then styleWithFix id 2314 - "In Bats, ! will not fail the test if it is not the last command anymore. Use `run ! ` (on Bats >= 1.5.0) instead." + then styleWithFix id 2314 "In Bats, ! will not fail the test if it is not the last command anymore. Use `run ! ` (on Bats >= 1.5.0) instead." (fixWith [replaceStart id params 0 "run "]) - else errWithFix id 2314 - "In Bats, ! does not cause a test failure. Use 'run ! ' (on Bats >= 1.5.0) instead." + else errWithFix id 2314 "In Bats, ! does not cause a test failure. Use 'run ! ' (on Bats >= 1.5.0) instead." (fixWith [replaceStart id params 0 "run "]) _ -> return () - isLastOf t commands = + isLastOf t commands = case commands of [x] -> x == t x:rest -> isLastOf t rest From 3a118246ef2e6e37129cb0f1c0d1dae319385520 Mon Sep 17 00:00:00 2001 From: Rune Juhl Jacobsen Date: Tue, 14 Dec 2021 16:00:47 +0100 Subject: [PATCH 007/244] Fix bug in 2126 when using after/before flags with grep Using `--after-context`/`-A` or `--before-context`/`-B` would give a warning recommending the user to use `grep -c`, even though that would give a different result than using `grep | wc -l`: ```fundamental $ echo -e "1\n2\n3" | grep -cA 3 1 1 $ echo -e "1\n2\n3" | grep -A 3 1 | wc -l 3 ``` --- src/ShellCheck/Analytics.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index d48104e..e6e47ea 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -545,6 +545,10 @@ prop_checkPipePitfalls15 = verifyNot checkPipePitfalls "foo | grep bar | wc -cmw prop_checkPipePitfalls16 = verifyNot checkPipePitfalls "foo | grep -r bar | wc -l" prop_checkPipePitfalls17 = verifyNot checkPipePitfalls "foo | grep -l bar | wc -l" prop_checkPipePitfalls18 = verifyNot checkPipePitfalls "foo | grep -L bar | wc -l" +prop_checkPipePitfalls19 = verifyNot checkPipePitfalls "foo | grep -A2 bar | wc -l" +prop_checkPipePitfalls20 = verifyNot checkPipePitfalls "foo | grep -B999 bar | wc -l" +prop_checkPipePitfalls21 = verifyNot checkPipePitfalls "foo | grep --after-context 999 bar | wc -l" +prop_checkPipePitfalls22 = verifyNot checkPipePitfalls "foo | grep -B 1 --after-context 999 bar | wc -l" checkPipePitfalls _ (T_Pipeline id _ commands) = do for ["find", "xargs"] $ \(find:xargs:_) -> @@ -566,10 +570,10 @@ checkPipePitfalls _ (T_Pipeline id _ commands) = do let flagsGrep = maybe [] (map snd . getAllFlags) $ getCommand grep flagsWc = maybe [] (map snd . getAllFlags) $ getCommand wc in - unless (any (`elem` ["l", "files-with-matches", "L", "files-without-matches", "o", "only-matching", "r", "R", "recursive"]) flagsGrep + unless (any (`elem` ["l", "files-with-matches", "L", "files-without-matches", "o", "only-matching", "r", "R", "recursive", "A", "after-context", "B", "before-context"]) flagsGrep || any (`elem` ["m", "chars", "w", "words", "c", "bytes", "L", "max-line-length"]) flagsWc || null flagsWc) $ - style (getId grep) 2126 "Consider using grep -c instead of grep|wc -l." + style (getId grep) 2126 "Consider using 'grep -c' instead of 'grep|wc -l'." didLs <- fmap or . sequence $ [ for' ["ls", "grep"] $ From e6e558946ca70985dfe1ac905af19e615cbc4cc6 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 21 Dec 2021 14:07:46 -0800 Subject: [PATCH 008/244] Improve decoding of single quoted literals (fixes #2418) --- src/ShellCheck/ASTLib.hs | 35 ++++++++++++++++++++++++++++------- 1 file changed, 28 insertions(+), 7 deletions(-) diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 83ba5f8..7c88432 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -369,6 +369,21 @@ getGlobOrLiteralString = getLiteralStringExt f f (T_Glob _ str) = return str f _ = Nothing + +prop_getLiteralString1 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x01") == Just "\1" +prop_getLiteralString2 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\xyz") == Just "\\xyz" +prop_getLiteralString3 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x1") == Just "\x1" +prop_getLiteralString4 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x1y") == Just "\x1y" +prop_getLiteralString5 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\xy") == Just "\\xy" +prop_getLiteralString6 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x") == Just "\\x" +prop_getLiteralString7 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\1x") == Just "\1x" +prop_getLiteralString8 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\12x") == Just "\o12x" +prop_getLiteralString9 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\123x") == Just "\o123x" +prop_getLiteralString10 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\1234") == Just "\o123\&4" +prop_getLiteralString11 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\1") == Just "\1" +prop_getLiteralString12 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\12") == Just "\o12" +prop_getLiteralString13 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\123") == Just "\o123" + -- Maybe get the literal value of a token, using a custom function -- to map unrecognized Tokens into strings. getLiteralStringExt :: Monad m => (Token -> m String) -> Token -> m String @@ -401,14 +416,15 @@ getLiteralStringExt more = g '\\' -> '\\' : rest 'x' -> case cs of - (x:y:more) -> - if isHexDigit x && isHexDigit y - then chr (16*(digitToInt x) + (digitToInt y)) : rest - else '\\':c:rest + (x:y:more) | isHexDigit x && isHexDigit y -> + chr (16*(digitToInt x) + (digitToInt y)) : decodeEscapes more + (x:more) | isHexDigit x -> + chr (digitToInt x) : decodeEscapes more + more -> '\\' : 'x' : decodeEscapes more _ | isOctDigit c -> - let digits = take 3 $ takeWhile isOctDigit (c:cs) - num = parseOct digits - in (if num < 256 then chr num else '?') : rest + let (digits, more) = spanMax isOctDigit 3 (c:cs) + num = (parseOct digits) `mod` 256 + in (chr num) : decodeEscapes more _ -> '\\' : c : rest where rest = decodeEscapes cs @@ -416,6 +432,11 @@ getLiteralStringExt more = g where f n "" = n f n (c:rest) = f (n * 8 + digitToInt c) rest + spanMax f n list = + let (first, second) = span f list + (prefix, suffix) = splitAt n first + in + (prefix, suffix ++ second) decodeEscapes (c:cs) = c : decodeEscapes cs decodeEscapes [] = [] From ade2bf7b871362c9c30878294aef8ab775f3ea07 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 9 Jan 2022 16:50:50 -0800 Subject: [PATCH 009/244] Allow parsing [[ x = ["$y"] ]] (fixes #2165) --- src/ShellCheck/Parser.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 92eb61f..8fbdb5a 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -556,7 +556,7 @@ readConditionContents single = notFollowedBy2 (try (spacing >> string "]")) x <- readNormalWord pos <- getPosition - when (endedWith "]" x && notArrayIndex x) $ do + when (notArrayIndex x && endedWith "]" x && not (x `containsLiteral` "[")) $ do parseProblemAt pos ErrorC 1020 $ "You need a space before the " ++ (if single then "]" else "]]") ++ "." fail "Missing space before ]" @@ -572,6 +572,7 @@ readConditionContents single = endedWith _ _ = False notArrayIndex (T_NormalWord id s@(_:T_Literal _ t:_)) = t /= "[" notArrayIndex _ = True + containsLiteral x s = s `isInfixOf` onlyLiteralString x readCondAndOp = readAndOrOp TC_And "&&" False <|> readAndOrOp TC_And "-a" True @@ -941,6 +942,9 @@ prop_readCondition23 = isOk readCondition "[[ -v arr[$var] ]]" prop_readCondition25 = isOk readCondition "[[ lex.yy.c -ot program.l ]]" prop_readCondition26 = isOk readScript "[[ foo ]]\\\n && bar" prop_readCondition27 = not $ isOk readConditionCommand "[[ x ]] foo" +prop_readCondition28 = isOk readCondition "[[ x = [\"$1\"] ]]" +prop_readCondition29 = isOk readCondition "[[ x = [*] ]]" + readCondition = called "test expression" $ do opos <- getPosition start <- startSpan From 2292e852e5be3a727a667dce9def79c1d12f0804 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 23 Jan 2022 14:23:56 -0800 Subject: [PATCH 010/244] Switch linux-x86_64 build from Ubuntu to Alpine for musl --- build/linux.x86_64/Dockerfile | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/build/linux.x86_64/Dockerfile b/build/linux.x86_64/Dockerfile index f0ad16a..3112ac2 100644 --- a/build/linux.x86_64/Dockerfile +++ b/build/linux.x86_64/Dockerfile @@ -1,16 +1,10 @@ -FROM ubuntu:20.04 +FROM alpine:latest ENV TARGETNAME linux.x86_64 # Install GHC and cabal USER root -ENV DEBIAN_FRONTEND noninteractive -RUN apt-get update && apt-get install -y ghc curl xz-utils - -# So we'd like a later version of Cabal that supports --enable-executable-static, -# but we can't use Ubuntu 20.10 because coreutils has switched to new syscalls that -# the TravisCI kernel doesn't support. Download it manually. -RUN curl "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-unknown-linux.tar.xz" | tar xJv -C /usr/bin +RUN apk add ghc cabal g++ libffi-dev curl bash # Use ld.bfd instead of ld.gold due to # x86_64-linux-gnu/libpthread.a(pthread_cond_init.o)(.note.stapsdt+0x14): error: From 88cdb4e2c9b45becb21bd02cd7b205d5bef8cb56 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 3 Feb 2022 19:23:46 -0800 Subject: [PATCH 011/244] Warn about spaces around = in alias (fixes #2442) --- src/ShellCheck/Checks/Commands.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 1a48a28..72d8c09 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -98,7 +98,7 @@ commandChecks = [ ,checkUnquotedEchoSpaces ,checkEvalArray ] - ++ map checkArgComparison declaringCommands + ++ map checkArgComparison ("alias" : declaringCommands) ++ map checkMaskedReturns declaringCommands @@ -1253,6 +1253,7 @@ prop_checkArgComparison3 = verifyNot (checkArgComparison "declare") "declare a=b prop_checkArgComparison4 = verify (checkArgComparison "export") "export a +=b" prop_checkArgComparison7 = verifyNot (checkArgComparison "declare") "declare -a +i foo" prop_checkArgComparison8 = verify (checkArgComparison "let") "let x = 0" +prop_checkArgComparison9 = verify (checkArgComparison "alias") "alias x =0" -- This mirrors checkSecondArgIsComparison but for arguments to local/readonly/declare/export checkArgComparison cmd = CommandCheck (Exactly cmd) wordsWithEqual where From fa15c0a454be93603418a56ed0d625e5c76a83fc Mon Sep 17 00:00:00 2001 From: Patrick Xia Date: Thu, 5 May 2022 16:09:02 -0700 Subject: [PATCH 012/244] add SC2316: error on multiple declarations like 'readonly local' --- src/ShellCheck/Checks/Commands.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 72d8c09..bad4cf2 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -100,6 +100,7 @@ commandChecks = [ ] ++ map checkArgComparison ("alias" : declaringCommands) ++ map checkMaskedReturns declaringCommands + ++ map checkMultipleDeclaring declaringCommands optionalChecks = map fst optionalCommandChecks @@ -941,6 +942,21 @@ checkLocalScope = CommandCheck (Exactly "local") $ \t -> unless (any isFunctionLike path) $ err (getId $ getCommandTokenOrThis t) 2168 "'local' is only valid in functions." +prop_checkMultipleDeclaring1 = verify (checkMultipleDeclaring "local") "q() { local readonly var=1; }" +prop_checkMultipleDeclaring2 = verifyNot (checkMultipleDeclaring "local") "q() { local var=1; }" +prop_checkMultipleDeclaring3 = verify (checkMultipleDeclaring "readonly") "readonly local foo=5" +prop_checkMultipleDeclaring4 = verify (checkMultipleDeclaring "export") "export readonly foo=5" +prop_checkMultipleDeclaring5 = verifyNot (checkMultipleDeclaring "local") "f() { local -r foo=5; }" +prop_checkMultipleDeclaring6 = verifyNot (checkMultipleDeclaring "declare") "declare -rx foo=5" +checkMultipleDeclaring cmd = CommandCheck (Exactly cmd) (mapM_ check . arguments) + where + check t = sequence_ $ do + lit <- getLiteralString t + guard $ lit `elem` declaringCommands + return $ err (getId $ getCommandTokenOrThis t) 2316 $ + "This applies " ++ cmd ++ " to the variable named " ++ lit ++ + ", which is probably not what you want. Use a separate command or the appropriate `declare` options instead." + prop_checkDeprecatedTempfile1 = verify checkDeprecatedTempfile "var=$(tempfile)" prop_checkDeprecatedTempfile2 = verifyNot checkDeprecatedTempfile "tempfile=$(mktemp)" checkDeprecatedTempfile = CommandCheck (Basename "tempfile") $ From 282155268829ffe450a21eb728ba0417c9c2578d Mon Sep 17 00:00:00 2001 From: Rune Juhl Jacobsen Date: Tue, 14 Dec 2021 16:00:47 +0100 Subject: [PATCH 013/244] Fix bug in 2126 when using after/before flags with grep Using `--after-context`/`-A` or `--before-context`/`-B` would give a warning recommending the user to use `grep -c`, even though that would give a different result than using `grep | wc -l`: ```fundamental $ echo -e "1\n2\n3" | grep -cA 3 1 1 $ echo -e "1\n2\n3" | grep -A 3 1 | wc -l 3 ``` --- src/ShellCheck/Analytics.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index d48104e..e6e47ea 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -545,6 +545,10 @@ prop_checkPipePitfalls15 = verifyNot checkPipePitfalls "foo | grep bar | wc -cmw prop_checkPipePitfalls16 = verifyNot checkPipePitfalls "foo | grep -r bar | wc -l" prop_checkPipePitfalls17 = verifyNot checkPipePitfalls "foo | grep -l bar | wc -l" prop_checkPipePitfalls18 = verifyNot checkPipePitfalls "foo | grep -L bar | wc -l" +prop_checkPipePitfalls19 = verifyNot checkPipePitfalls "foo | grep -A2 bar | wc -l" +prop_checkPipePitfalls20 = verifyNot checkPipePitfalls "foo | grep -B999 bar | wc -l" +prop_checkPipePitfalls21 = verifyNot checkPipePitfalls "foo | grep --after-context 999 bar | wc -l" +prop_checkPipePitfalls22 = verifyNot checkPipePitfalls "foo | grep -B 1 --after-context 999 bar | wc -l" checkPipePitfalls _ (T_Pipeline id _ commands) = do for ["find", "xargs"] $ \(find:xargs:_) -> @@ -566,10 +570,10 @@ checkPipePitfalls _ (T_Pipeline id _ commands) = do let flagsGrep = maybe [] (map snd . getAllFlags) $ getCommand grep flagsWc = maybe [] (map snd . getAllFlags) $ getCommand wc in - unless (any (`elem` ["l", "files-with-matches", "L", "files-without-matches", "o", "only-matching", "r", "R", "recursive"]) flagsGrep + unless (any (`elem` ["l", "files-with-matches", "L", "files-without-matches", "o", "only-matching", "r", "R", "recursive", "A", "after-context", "B", "before-context"]) flagsGrep || any (`elem` ["m", "chars", "w", "words", "c", "bytes", "L", "max-line-length"]) flagsWc || null flagsWc) $ - style (getId grep) 2126 "Consider using grep -c instead of grep|wc -l." + style (getId grep) 2126 "Consider using 'grep -c' instead of 'grep|wc -l'." didLs <- fmap or . sequence $ [ for' ["ls", "grep"] $ From fd595d1058a7991a3e925922be2da96c3c023faa Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 6 May 2022 10:06:12 -0700 Subject: [PATCH 014/244] Only trigger SC2316 on unquoted words. --- src/ShellCheck/Checks/Commands.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index bad4cf2..e65dc68 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -948,10 +948,11 @@ prop_checkMultipleDeclaring3 = verify (checkMultipleDeclaring "readonly") "reado prop_checkMultipleDeclaring4 = verify (checkMultipleDeclaring "export") "export readonly foo=5" prop_checkMultipleDeclaring5 = verifyNot (checkMultipleDeclaring "local") "f() { local -r foo=5; }" prop_checkMultipleDeclaring6 = verifyNot (checkMultipleDeclaring "declare") "declare -rx foo=5" +prop_checkMultipleDeclaring7 = verifyNot (checkMultipleDeclaring "readonly") "readonly 'local' foo=5" checkMultipleDeclaring cmd = CommandCheck (Exactly cmd) (mapM_ check . arguments) where check t = sequence_ $ do - lit <- getLiteralString t + lit <- getUnquotedLiteral t guard $ lit `elem` declaringCommands return $ err (getId $ getCommandTokenOrThis t) 2316 $ "This applies " ++ cmd ++ " to the variable named " ++ lit ++ From 399c04cc17931c5221672257666f39eda6aefc14 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 6 May 2022 10:11:52 -0700 Subject: [PATCH 015/244] Mention SC2316 in changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index f65bbfa..fb733ce 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,6 @@ ## Git ### Added +- SC2316: Warn about 'local readonly foo' and similar (thanks, patrickxia!) ### Fixed From 9aa4c22aa6fb54d511148bdc8b135e353529ffcc Mon Sep 17 00:00:00 2001 From: Frazer Smith Date: Mon, 16 May 2022 06:56:46 +0000 Subject: [PATCH 016/244] ci: update github actions --- .github/workflows/build.yml | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 5595219..a435cf4 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -15,7 +15,7 @@ jobs: sudo apt-get install cabal-install - name: Checkout repository - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 @@ -37,7 +37,7 @@ jobs: mv dist-newstyle/sdist/*.tar.gz source/source.tar.gz - name: Upload artifact - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v3 with: name: source path: source/ @@ -51,10 +51,10 @@ jobs: runs-on: ubuntu-latest steps: - name: Checkout repository - uses: actions/checkout@v2 + uses: actions/checkout@v3 - name: Download artifacts - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v3 - name: Build source run: | @@ -63,7 +63,7 @@ jobs: ( cd bin && ../build/run_builder ../source/source.tar.gz ../build/${{matrix.build}} ) - name: Upload artifact - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v3 with: name: bin path: bin/ @@ -74,10 +74,10 @@ jobs: runs-on: ubuntu-latest steps: - name: Checkout repository - uses: actions/checkout@v2 + uses: actions/checkout@v3 - name: Download artifacts - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v3 - name: Work around GitHub permissions bug run: chmod +x bin/*/shellcheck* @@ -92,7 +92,7 @@ jobs: rm -rf */ README* LICENSE* - name: Upload artifact - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v3 with: name: deploy path: deploy/ @@ -104,10 +104,10 @@ jobs: environment: Deploy steps: - name: Checkout repository - uses: actions/checkout@v2 + uses: actions/checkout@v3 - name: Download artifacts - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v3 - name: Upload to GitHub env: From 7ceb1f15193f43109a547ccc3d8ba74faaa72ade Mon Sep 17 00:00:00 2001 From: ygeyzel Date: Sun, 17 Jul 2022 21:46:42 +0300 Subject: [PATCH 017/244] SC2183 grammer fix: 'variable' instead of 'variables' if only one variable --- src/ShellCheck/Checks/Commands.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index e65dc68..d8635ea 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -675,6 +675,7 @@ checkPrintfVar = CommandCheck (Exactly "printf") (f . arguments) where let formats = getPrintfFormats string let formatCount = length formats let argCount = length more + let pluraliseIfMany word n = if n > 1 then word ++ "s" else word return $ if | argCount == 0 && formatCount == 0 -> @@ -690,7 +691,8 @@ checkPrintfVar = CommandCheck (Exactly "printf") (f . arguments) where return () -- Great: a suitable number of arguments | otherwise -> warn (getId format) 2183 $ - "This format string has " ++ show formatCount ++ " variables, but is passed " ++ show argCount ++ " arguments." + "This format string has " ++ show formatCount ++ " " ++ (pluraliseIfMany "variable" formatCount) ++ + ", but is passed " ++ show argCount ++ " arguments." unless ('%' `elem` concat (oversimplify format) || isLiteral format) $ info (getId format) 2059 From 363c0633e0525e6e7d1714cac83e420875345b85 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 11 Feb 2022 17:17:04 -0800 Subject: [PATCH 018/244] When reparsing array indices, do it recursively --- src/ShellCheck/Analytics.hs | 1 + src/ShellCheck/Parser.hs | 9 +++++---- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e6e47ea..7da5786 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2394,6 +2394,7 @@ prop_checkUnused47= verifyNotTree checkUnusedAssignments "a=1; alias hello='echo prop_checkUnused48= verifyNotTree checkUnusedAssignments "_a=1" prop_checkUnused49= verifyNotTree checkUnusedAssignments "declare -A array; key=a; [[ -v array[$key] ]]" prop_checkUnused50= verifyNotTree checkUnusedAssignments "foofunc() { :; }; typeset -fx foofunc" +prop_checkUnused51= verifyTree checkUnusedAssignments "x[y[z=1]]=1; echo ${x[@]}" checkUnusedAssignments params t = execWriter (mapM_ warnFor unused) where diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 8fbdb5a..833918c 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -3463,9 +3463,9 @@ notesForContext list = zipWith ($) [first, second] $ filter isName list -- Go over all T_UnparsedIndex and reparse them as either arithmetic or text -- depending on declare -A statements. -reparseIndices root = - analyze blank blank f root +reparseIndices root = process root where + process = analyze blank blank f associative = getAssociativeArrays root isAssociative s = s `elem` associative f (T_Assignment id mode name indices value) = do @@ -3490,8 +3490,9 @@ reparseIndices root = fixAssignmentIndex name word = case word of - T_UnparsedIndex id pos src -> - parsed name pos src + T_UnparsedIndex id pos src -> do + idx <- parsed name pos src + process idx -- Recursively parse for cases like x[y[z=1]]=1 _ -> return word parsed name pos src = From a4042f752399b0aff032692331e9f561c2cb836c Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 18 Jul 2022 22:12:31 -0700 Subject: [PATCH 019/244] Parse &&/|| as left-associative --- src/ShellCheck/Analytics.hs | 2 +- src/ShellCheck/Parser.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 7da5786..f5ff4df 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -867,7 +867,7 @@ prop_checkShorthandIf5 = verifyNot checkShorthandIf "foo && rm || printf b" prop_checkShorthandIf6 = verifyNot checkShorthandIf "if foo && bar || baz; then true; fi" prop_checkShorthandIf7 = verifyNot checkShorthandIf "while foo && bar || baz; do true; done" prop_checkShorthandIf8 = verify checkShorthandIf "if true; then foo && bar || baz; fi" -checkShorthandIf params x@(T_AndIf id _ (T_OrIf _ _ (T_Pipeline _ _ t))) +checkShorthandIf params x@(T_OrIf _ (T_AndIf id _ _) (T_Pipeline _ _ t)) | not (isOk t || inCondition) = info id 2015 "Note that A && B || C is not if-then-else. C may run when A is true." where diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 833918c..3958406 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -2286,7 +2286,7 @@ readAndOr = do parseProblemAt apos ErrorC 1123 "ShellCheck directives are only valid in front of complete compound commands, like 'if', not e.g. individual 'elif' branches." andOr <- withAnnotations annotations $ - chainr1 readPipeline $ do + chainl1 readPipeline $ do op <- g_AND_IF <|> g_OR_IF readLineBreak return $ case op of T_AND_IF id -> T_AndIf id From c3bce51de38fa57b006b932661bdb6237e0c5db5 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 19 Jul 2022 17:45:54 -0700 Subject: [PATCH 020/244] Allow text to build on Fedora by installing dependencies --- test/distrotest | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/distrotest b/test/distrotest index 50a5a17..464768c 100755 --- a/test/distrotest +++ b/test/distrotest @@ -63,7 +63,7 @@ debian:testing apt-get update && apt-get install -y cabal-install ubuntu:latest apt-get update && apt-get install -y cabal-install haskell:latest true opensuse/leap:latest zypper install -y cabal-install ghc -fedora:latest dnf install -y cabal-install ghc-template-haskell-devel findutils +fedora:latest dnf install -y cabal-install ghc-template-haskell-devel findutils libstdc++-static gcc-c++ archlinux:latest pacman -S -y --noconfirm cabal-install ghc-static base-devel # Ubuntu LTS From cc04b4011967f873e14c0e6ad506ca37bed1f97f Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 19 Jul 2022 18:22:11 -0700 Subject: [PATCH 021/244] Freeze macOS dependency by sha256 --- build/darwin.x86_64/Dockerfile | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/build/darwin.x86_64/Dockerfile b/build/darwin.x86_64/Dockerfile index ecd1cad..9e33a82 100644 --- a/build/darwin.x86_64/Dockerfile +++ b/build/darwin.x86_64/Dockerfile @@ -1,5 +1,4 @@ -# DIGEST:sha256:fa32af4677e2860a1c5950bc8c360f309e2a87e2ddfed27b642fddf7a6093b76 -FROM liushuyu/osxcross:latest +FROM liushuyu/osxcross@sha256:fa32af4677e2860a1c5950bc8c360f309e2a87e2ddfed27b642fddf7a6093b76 ENV TARGET x86_64-apple-darwin18 ENV TARGETNAME darwin.x86_64 From 7946bf5657905bba74be360bf16b287008ed1bdb Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 19 Jul 2022 21:40:03 -0700 Subject: [PATCH 022/244] Upgrade cURL for Windows build image --- build/windows.x86_64/Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build/windows.x86_64/Dockerfile b/build/windows.x86_64/Dockerfile index 11e67e8..1e5c5d9 100644 --- a/build/windows.x86_64/Dockerfile +++ b/build/windows.x86_64/Dockerfile @@ -12,7 +12,7 @@ WORKDIR /haskell RUN curl -L "https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-x86_64-unknown-mingw32.tar.xz" | tar xJ --strip-components=1 WORKDIR /haskell/bin RUN curl -L "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-unknown-mingw32.zip" | busybox unzip - -RUN curl -L "https://curl.se/windows/dl-7.75.0/curl-7.75.0-win64-mingw.zip" | busybox unzip - && mv curl-7.75.0-win64-mingw/bin/* . +RUN curl -L "https://curl.se/windows/dl-7.84.0/curl-7.84.0-win64-mingw.zip" | busybox unzip - && mv curl-7.84.0-win64-mingw/bin/* . ENV WINEPATH /haskell/bin # It's unknown whether Cabal on Windows suffers from the same issue From f77a545282f02010a0c52b66bd6ee5e860c2b314 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 19 Jul 2022 14:23:27 -0700 Subject: [PATCH 023/244] Control Flow Graph / Data Flow Analysis support --- CHANGELOG.md | 4 + ShellCheck.cabal | 8 + src/ShellCheck/ASTLib.hs | 116 ++- src/ShellCheck/Analytics.hs | 2 + src/ShellCheck/Analyzer.hs | 5 +- src/ShellCheck/AnalyzerLib.hs | 142 +-- src/ShellCheck/CFG.hs | 1147 +++++++++++++++++++++++++ src/ShellCheck/CFGAnalysis.hs | 1113 ++++++++++++++++++++++++ src/ShellCheck/Checks/Commands.hs | 1 + src/ShellCheck/Checks/ControlFlow.hs | 101 +++ src/ShellCheck/Checks/ShellSupport.hs | 1 + src/ShellCheck/Data.hs | 29 +- src/ShellCheck/Debug.hs | 313 +++++++ src/ShellCheck/Fixer.hs | 3 +- src/ShellCheck/Parser.hs | 5 +- src/ShellCheck/Prelude.hs | 48 ++ test/shellcheck.hs | 6 + 17 files changed, 2909 insertions(+), 135 deletions(-) create mode 100644 src/ShellCheck/CFG.hs create mode 100644 src/ShellCheck/CFGAnalysis.hs create mode 100644 src/ShellCheck/Checks/ControlFlow.hs create mode 100644 src/ShellCheck/Debug.hs create mode 100644 src/ShellCheck/Prelude.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index fb733ce..4763ddd 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,10 @@ ### Fixed ### Changed +- ShellCheck now has a Data Flow Analysis engine to make smarter decisions + based on control flow rather than just syntax. Existing checks will + gradually start using it, which may cause them to trigger differently + (but more accurately). ## v0.8.0 - 2021-11-06 diff --git a/ShellCheck.cabal b/ShellCheck.cabal index 1167c82..b22b5c8 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -53,6 +53,7 @@ library deepseq >= 1.4.0.0, Diff >= 0.2.0, directory >= 1.2.3.0, + fgl, mtl >= 2.2.1, filepath, parsec, @@ -66,11 +67,15 @@ library ShellCheck.Analytics ShellCheck.Analyzer ShellCheck.AnalyzerLib + ShellCheck.CFG + ShellCheck.CFGAnalysis ShellCheck.Checker ShellCheck.Checks.Commands + ShellCheck.Checks.ControlFlow ShellCheck.Checks.Custom ShellCheck.Checks.ShellSupport ShellCheck.Data + ShellCheck.Debug ShellCheck.Fixer ShellCheck.Formatter.Format ShellCheck.Formatter.CheckStyle @@ -82,6 +87,7 @@ library ShellCheck.Formatter.Quiet ShellCheck.Interface ShellCheck.Parser + ShellCheck.Prelude ShellCheck.Regex other-modules: Paths_ShellCheck @@ -100,6 +106,7 @@ executable shellcheck deepseq >= 1.4.0.0, Diff >= 0.2.0, directory >= 1.2.3.0, + fgl, mtl >= 2.2.1, filepath, parsec >= 3.0, @@ -120,6 +127,7 @@ test-suite test-shellcheck deepseq >= 1.4.0.0, Diff >= 0.2.0, directory >= 1.2.3.0, + fgl, mtl >= 2.2.1, filepath, parsec, diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 7c88432..7cc5af2 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -21,6 +21,7 @@ module ShellCheck.ASTLib where import ShellCheck.AST +import ShellCheck.Prelude import ShellCheck.Regex import Control.Monad.Writer @@ -138,7 +139,7 @@ getFlagsUntil stopCondition (T_SimpleCommand _ _ (_:args)) = flag (x, '-':'-':arg) = [ (x, takeWhile (/= '=') arg) ] flag (x, '-':args) = map (\v -> (x, [v])) args flag (x, _) = [ (x, "") ] -getFlagsUntil _ _ = error "Internal shellcheck error, please report! (getFlags on non-command)" +getFlagsUntil _ _ = error $ pleaseReport "getFlags on non-command" -- Get all flags in a GNU way, up until -- getAllFlags :: Token -> [(Token, String)] @@ -785,5 +786,118 @@ executableFromShebang = shellFor basename s = reverse . takeWhile (/= '/') . reverse $ s skipFlags = dropWhile ("-" `isPrefixOf`) + +-- Determining if a name is a variable +isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x +isVariableChar x = isVariableStartChar x || isDigit x +isSpecialVariableChar = (`elem` "*@#?-$!") +variableNameRegex = mkRegex "[_a-zA-Z][_a-zA-Z0-9]*" + +prop_isVariableName1 = isVariableName "_fo123" +prop_isVariableName2 = not $ isVariableName "4" +prop_isVariableName3 = not $ isVariableName "test: " +isVariableName (x:r) = isVariableStartChar x && all isVariableChar r +isVariableName _ = False + + +-- Get the variable name from an expansion like ${var:-foo} +prop_getBracedReference1 = getBracedReference "foo" == "foo" +prop_getBracedReference2 = getBracedReference "#foo" == "foo" +prop_getBracedReference3 = getBracedReference "#" == "#" +prop_getBracedReference4 = getBracedReference "##" == "#" +prop_getBracedReference5 = getBracedReference "#!" == "!" +prop_getBracedReference6 = getBracedReference "!#" == "#" +prop_getBracedReference7 = getBracedReference "!foo#?" == "foo" +prop_getBracedReference8 = getBracedReference "foo-bar" == "foo" +prop_getBracedReference9 = getBracedReference "foo:-bar" == "foo" +prop_getBracedReference10= getBracedReference "foo: -1" == "foo" +prop_getBracedReference11= getBracedReference "!os*" == "" +prop_getBracedReference11b= getBracedReference "!os@" == "" +prop_getBracedReference12= getBracedReference "!os?bar**" == "" +prop_getBracedReference13= getBracedReference "foo[bar]" == "foo" +getBracedReference s = fromMaybe s $ + nameExpansion s `mplus` takeName noPrefix `mplus` getSpecial noPrefix `mplus` getSpecial s + where + noPrefix = dropPrefix s + dropPrefix (c:rest) | c `elem` "!#" = rest + dropPrefix cs = cs + takeName s = do + let name = takeWhile isVariableChar s + guard . not $ null name + return name + getSpecial (c:_) | isSpecialVariableChar c = return [c] + getSpecial _ = fail "empty or not special" + + nameExpansion ('!':next:rest) = do -- e.g. ${!foo*bar*} + guard $ isVariableChar next -- e.g. ${!@} + first <- find (not . isVariableChar) rest + guard $ first `elem` "*?@" + return "" + nameExpansion _ = Nothing + +-- Get the variable modifier like /a/b in ${var/a/b} +prop_getBracedModifier1 = getBracedModifier "foo:bar:baz" == ":bar:baz" +prop_getBracedModifier2 = getBracedModifier "!var:-foo" == ":-foo" +prop_getBracedModifier3 = getBracedModifier "foo[bar]" == "[bar]" +prop_getBracedModifier4 = getBracedModifier "foo[@]@Q" == "[@]@Q" +prop_getBracedModifier5 = getBracedModifier "@@Q" == "@Q" +getBracedModifier s = headOrDefault "" $ do + let var = getBracedReference s + a <- dropModifier s + dropPrefix var a + where + dropPrefix [] t = return t + dropPrefix (a:b) (c:d) | a == c = dropPrefix b d + dropPrefix _ _ = [] + + dropModifier (c:rest) | c `elem` "#!" = [rest, c:rest] + dropModifier x = [x] + +-- Get the variables from indices like ["x", "y"] in ${var[x+y+1]} +prop_getIndexReferences1 = getIndexReferences "var[x+y+1]" == ["x", "y"] +getIndexReferences s = fromMaybe [] $ do + match <- matchRegex re s + index <- match !!! 0 + return $ matchAllStrings variableNameRegex index + where + re = mkRegex "(\\[.*\\])" + +prop_getOffsetReferences1 = getOffsetReferences ":bar" == ["bar"] +prop_getOffsetReferences2 = getOffsetReferences ":bar:baz" == ["bar", "baz"] +prop_getOffsetReferences3 = getOffsetReferences "[foo]:bar" == ["bar"] +prop_getOffsetReferences4 = getOffsetReferences "[foo]:bar:baz" == ["bar", "baz"] +getOffsetReferences mods = fromMaybe [] $ do +-- if mods start with [, then drop until ] + match <- matchRegex re mods + offsets <- match !!! 1 + return $ matchAllStrings variableNameRegex offsets + where + re = mkRegex "^(\\[.+\\])? *:([^-=?+].*)" + + +-- Returns whether a token is a parameter expansion without any modifiers. +-- True for $var ${var} $1 $# +-- False for ${#var} ${var[x]} ${var:-0} +isUnmodifiedParameterExpansion t = + case t of + T_DollarBraced _ False _ -> True + T_DollarBraced _ _ list -> + let str = concat $ oversimplify list + in getBracedReference str == str + _ -> False + +--- A list of the element and all its parents up to the root node. +getPath tree t = t : + case Map.lookup (getId t) tree of + Nothing -> [] + Just parent -> getPath tree parent + +isClosingFileOp op = + case op of + T_IoDuplicate _ (T_GREATAND _) "-" -> True + T_IoDuplicate _ (T_LESSAND _) "-" -> True + _ -> False + + return [] runTests = $quickCheckAll diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index f5ff4df..bf5d179 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -24,8 +24,10 @@ module ShellCheck.Analytics (runAnalytics, optionalChecks, ShellCheck.Analytics. import ShellCheck.AST import ShellCheck.ASTLib import ShellCheck.AnalyzerLib hiding (producesComments) +import qualified ShellCheck.CFGAnalysis as CF import ShellCheck.Data import ShellCheck.Parser +import ShellCheck.Prelude import ShellCheck.Interface import ShellCheck.Regex diff --git a/src/ShellCheck/Analyzer.hs b/src/ShellCheck/Analyzer.hs index eb231c2..ff2e457 100644 --- a/src/ShellCheck/Analyzer.hs +++ b/src/ShellCheck/Analyzer.hs @@ -25,6 +25,7 @@ import ShellCheck.Interface import Data.List import Data.Monoid import qualified ShellCheck.Checks.Commands +import qualified ShellCheck.Checks.ControlFlow import qualified ShellCheck.Checks.Custom import qualified ShellCheck.Checks.ShellSupport @@ -42,11 +43,13 @@ analyzeScript spec = newAnalysisResult { checkers spec params = mconcat $ map ($ params) [ ShellCheck.Checks.Commands.checker spec, + ShellCheck.Checks.ControlFlow.checker spec, ShellCheck.Checks.Custom.checker, ShellCheck.Checks.ShellSupport.checker ] optionalChecks = mconcat $ [ ShellCheck.Analytics.optionalChecks, - ShellCheck.Checks.Commands.optionalChecks + ShellCheck.Checks.Commands.optionalChecks, + ShellCheck.Checks.ControlFlow.optionalChecks ] diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 67c35b4..e998f2c 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -23,9 +23,11 @@ module ShellCheck.AnalyzerLib where import ShellCheck.AST import ShellCheck.ASTLib +import qualified ShellCheck.CFGAnalysis as CF import ShellCheck.Data import ShellCheck.Interface import ShellCheck.Parser +import ShellCheck.Prelude import ShellCheck.Regex import Control.Arrow (first) @@ -96,7 +98,9 @@ data Parameters = Parameters { -- The root node of the AST rootNode :: Token, -- map from token id to start and end position - tokenPositions :: Map.Map Id (Position, Position) + tokenPositions :: Map.Map Id (Position, Position), + -- Result from Control Flow Graph analysis (including data flow analysis) + cfgAnalysis :: CF.CFGAnalysis } deriving (Show) -- TODO: Cache results of common AST ops here @@ -189,8 +193,9 @@ makeCommentWithFix severity id code str fix = } in force withFix -makeParameters spec = - let params = Parameters { +makeParameters spec = params + where + params = Parameters { rootNode = root, shellType = fromMaybe (determineShell (asFallbackShell spec) root) $ asShellType spec, hasSetE = containsSetE root, @@ -215,9 +220,14 @@ makeParameters spec = shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec), parentMap = getParentTree root, variableFlow = getVariableFlow params root, - tokenPositions = asTokenPositions spec - } in params - where root = asScript spec + tokenPositions = asTokenPositions spec, + cfgAnalysis = CF.analyzeControlFlow cfParams root + } + cfParams = CF.CFGParameters { + CF.cfLastpipe = hasLastpipe params, + CF.cfPipefail = hasPipefail params + } + root = asScript spec -- Does this script mention 'set -e' anywhere? @@ -408,12 +418,6 @@ usedAsCommandName tree token = go (getId token) (tail $ getPath tree token) getId word == currentId || getId (getCommandTokenOrThis t) == currentId go _ _ = False --- A list of the element and all its parents up to the root node. -getPath tree t = t : - case Map.lookup (getId t) tree of - Nothing -> [] - Just parent -> getPath tree parent - -- Version of the above taking the map from the current context -- Todo: give this the name "getPath" getPathM t = do @@ -559,12 +563,6 @@ getModifiedVariables t = return (place, t, str, DataString SourceChecked) _ -> Nothing -isClosingFileOp op = - case op of - T_IoDuplicate _ (T_GREATAND _) "-" -> True - T_IoDuplicate _ (T_LESSAND _) "-" -> True - _ -> False - -- Consider 'export/declare -x' a reference, since it makes the var available getReferencedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Literal _ x:_):rest)) = @@ -746,13 +744,6 @@ getModifiedVariableCommand base@(T_SimpleCommand id cmdPrefix (T_NormalWord _ (T getModifiedVariableCommand _ = [] -getIndexReferences s = fromMaybe [] $ do - match <- matchRegex re s - index <- match !!! 0 - return $ matchAllStrings variableNameRegex index - where - re = mkRegex "(\\[.*\\])" - -- Given a NormalWord like foo or foo[$bar], get foo. -- Primarily used to get references for [[ -v foo[bar] ]] getVariableForTestDashV :: Token -> Maybe String @@ -767,18 +758,6 @@ getVariableForTestDashV t = do -- in a non-constant expression (while filtering out foo$x[$y]) toStr _ = return "\0" -prop_getOffsetReferences1 = getOffsetReferences ":bar" == ["bar"] -prop_getOffsetReferences2 = getOffsetReferences ":bar:baz" == ["bar", "baz"] -prop_getOffsetReferences3 = getOffsetReferences "[foo]:bar" == ["bar"] -prop_getOffsetReferences4 = getOffsetReferences "[foo]:bar:baz" == ["bar", "baz"] -getOffsetReferences mods = fromMaybe [] $ do --- if mods start with [, then drop until ] - match <- matchRegex re mods - offsets <- match !!! 1 - return $ matchAllStrings variableNameRegex offsets - where - re = mkRegex "^(\\[.+\\])? *:([^-=?+].*)" - getReferencedVariables parents t = case t of T_DollarBraced id _ l -> let str = concat $ oversimplify l in @@ -857,17 +836,6 @@ isConfusedGlobRegex ('*':_) = True isConfusedGlobRegex [x,'*'] | x `notElem` "\\." = True isConfusedGlobRegex _ = False -isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x -isVariableChar x = isVariableStartChar x || isDigit x -isSpecialVariableChar = (`elem` "*@#?-$!") -variableNameRegex = mkRegex "[_a-zA-Z][_a-zA-Z0-9]*" - -prop_isVariableName1 = isVariableName "_fo123" -prop_isVariableName2 = not $ isVariableName "4" -prop_isVariableName3 = not $ isVariableName "test: " -isVariableName (x:r) = isVariableStartChar x && all isVariableChar r -isVariableName _ = False - getVariablesFromLiteralToken token = getVariablesFromLiteral (getLiteralStringDef " " token) @@ -880,73 +848,6 @@ getVariablesFromLiteral string = where variableRegex = mkRegex "\\$\\{?([A-Za-z0-9_]+)" --- Get the variable name from an expansion like ${var:-foo} -prop_getBracedReference1 = getBracedReference "foo" == "foo" -prop_getBracedReference2 = getBracedReference "#foo" == "foo" -prop_getBracedReference3 = getBracedReference "#" == "#" -prop_getBracedReference4 = getBracedReference "##" == "#" -prop_getBracedReference5 = getBracedReference "#!" == "!" -prop_getBracedReference6 = getBracedReference "!#" == "#" -prop_getBracedReference7 = getBracedReference "!foo#?" == "foo" -prop_getBracedReference8 = getBracedReference "foo-bar" == "foo" -prop_getBracedReference9 = getBracedReference "foo:-bar" == "foo" -prop_getBracedReference10= getBracedReference "foo: -1" == "foo" -prop_getBracedReference11= getBracedReference "!os*" == "" -prop_getBracedReference11b= getBracedReference "!os@" == "" -prop_getBracedReference12= getBracedReference "!os?bar**" == "" -prop_getBracedReference13= getBracedReference "foo[bar]" == "foo" -getBracedReference s = fromMaybe s $ - nameExpansion s `mplus` takeName noPrefix `mplus` getSpecial noPrefix `mplus` getSpecial s - where - noPrefix = dropPrefix s - dropPrefix (c:rest) | c `elem` "!#" = rest - dropPrefix cs = cs - takeName s = do - let name = takeWhile isVariableChar s - guard . not $ null name - return name - getSpecial (c:_) | isSpecialVariableChar c = return [c] - getSpecial _ = fail "empty or not special" - - nameExpansion ('!':next:rest) = do -- e.g. ${!foo*bar*} - guard $ isVariableChar next -- e.g. ${!@} - first <- find (not . isVariableChar) rest - guard $ first `elem` "*?@" - return "" - nameExpansion _ = Nothing - -prop_getBracedModifier1 = getBracedModifier "foo:bar:baz" == ":bar:baz" -prop_getBracedModifier2 = getBracedModifier "!var:-foo" == ":-foo" -prop_getBracedModifier3 = getBracedModifier "foo[bar]" == "[bar]" -prop_getBracedModifier4 = getBracedModifier "foo[@]@Q" == "[@]@Q" -prop_getBracedModifier5 = getBracedModifier "@@Q" == "@Q" -getBracedModifier s = headOrDefault "" $ do - let var = getBracedReference s - a <- dropModifier s - dropPrefix var a - where - dropPrefix [] t = return t - dropPrefix (a:b) (c:d) | a == c = dropPrefix b d - dropPrefix _ _ = [] - - dropModifier (c:rest) | c `elem` "#!" = [rest, c:rest] - dropModifier x = [x] - --- Useful generic functions. - --- Get element 0 or a default. Like `head` but safe. -headOrDefault _ (a:_) = a -headOrDefault def _ = def - --- Get the last element or a default. Like `last` but safe. -lastOrDefault def [] = def -lastOrDefault _ list = last list - ---- Get element n of a list, or Nothing. Like `!!` but safe. -(!!!) list i = - case drop i list of - [] -> Nothing - (r:_) -> Just r -- Run a command if the shell is in the given list whenShell l c = do @@ -999,17 +900,6 @@ isBashLike params = Dash -> False Sh -> False --- Returns whether a token is a parameter expansion without any modifiers. --- True for $var ${var} $1 $# --- False for ${#var} ${var[x]} ${var:-0} -isUnmodifiedParameterExpansion t = - case t of - T_DollarBraced _ False _ -> True - T_DollarBraced _ _ list -> - let str = concat $ oversimplify list - in getBracedReference str == str - _ -> False - isTrueAssignmentSource c = case c of DataString SourceChecked -> False diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs new file mode 100644 index 0000000..101a0d7 --- /dev/null +++ b/src/ShellCheck/CFG.hs @@ -0,0 +1,1147 @@ +{- + Copyright 2022 Vidar Holen + + This file is part of ShellCheck. + https://www.shellcheck.net + + ShellCheck is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + ShellCheck is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-} + +-- Constructs a Control Flow Graph from an AST +module ShellCheck.CFG ( + CFNode (..), + CFEdge (..), + CFEffect (..), + CFStringPart (..), + CFVariableProp (..), + CFGResult (..), + CFValue (..), + CFGraph, + CFGParameters (..), + IdTagged (..), + buildGraph + , ShellCheck.CFG.runTests -- STRIP + ) + where + +import GHC.Generics (Generic) +import ShellCheck.AST +import ShellCheck.ASTLib +import ShellCheck.Interface +import ShellCheck.Prelude +import ShellCheck.Regex +import Control.DeepSeq +import Control.Monad +import Control.Monad.Identity +import Data.List hiding (map) +import Data.Maybe +import qualified Data.Map as M +import qualified Data.Set as S +import Control.Monad.RWS.Lazy +import Data.Graph.Inductive.Graph +import Data.Graph.Inductive.Query.DFS +import Data.Graph.Inductive.PatriciaTree as G +import Debug.Trace -- STRIP + +import Test.QuickCheck.All (forAllProperties) +import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess) + + +-- Our basic Graph type +type CFGraph = G.Gr CFNode CFEdge + +-- Node labels in a Control Flow Graph +data CFNode = + -- A no-op node for structural purposes + CFStructuralNode + -- A no-op for graph inspection purposes + | CFEntryPoint String + -- Drop current prefix assignments + | CFDropPrefixAssignments + -- A node with a certain effect on program state + | CFApplyEffects [IdTagged CFEffect] + -- The execution of a command or function by literal string if possible + | CFExecuteCommand (Maybe String) + -- Execute a subshell. These are represented by disjoint graphs just like + -- functions, but they don't require any form of name resolution + | CFExecuteSubshell String Node Node + -- Assignment of $? + | CFSetExitCode Id + -- The virtual 'exit' at the natural end of a subshell + | CFImpliedExit + -- An exit statement resolvable at CFG build time + | CFResolvedExit + -- An exit statement only resolvable at DFA time + | CFUnresolvedExit + -- An unreachable node, serving as the unconnected end point of a range + | CFUnreachable + -- Assignment of $! + | CFSetBackgroundPid Id + deriving (Eq, Ord, Show, Generic, NFData) + +-- Edge labels in a Control Flow Graph +data CFEdge = + CFEErrExit + -- Regular control flow edge + | CFEFlow + -- An edge that a human might think exists (e.g. from a backgrounded process to its parent) + | CFEFalseFlow + -- An edge followed on exit + | CFEExit + deriving (Eq, Ord, Show, Generic, NFData) + +-- Actions we track +data CFEffect = + CFModifyProps String [CFVariableProp] + | CFReadVariable String + | CFWriteVariable String CFValue + | CFWriteGlobal String CFValue + | CFWriteLocal String CFValue + | CFWritePrefix String CFValue + | CFDefineFunction String Id Node Node + | CFUndefine String + | CFUndefineVariable String + | CFUndefineFunction String + | CFUndefineNameref String + -- Usage implies that this is an array (e.g. it's expanded with index) + | CFHintArray String + -- Operation implies that the variable will be defined (e.g. [ -z "$var" ]) + | CFHintDefined String + deriving (Eq, Ord, Show, Generic, NFData) + +data IdTagged a = IdTagged Id a + deriving (Eq, Ord, Show, Generic, NFData) + +-- Where a variable's value comes from +data CFValue = + -- The special 'uninitialized' value + CFValueUninitialized + -- An arbitrary array value + | CFValueArray + -- An arbitrary string value + | CFValueString + -- An arbitrary integer + | CFValueInteger + -- Token 'Id' concatenates and assigns the given parts + | CFValueComputed Id [CFStringPart] + deriving (Eq, Ord, Show, Generic, NFData) + +-- Simplified computed strings +data CFStringPart = + -- A known literal string value, like 'foo' + CFStringLiteral String + -- The contents of a variable, like $foo + | CFStringVariable String + -- An value that is unknown but an integer + | CFStringInteger + -- An unknown string value, for things we can't handle + | CFStringUnknown + deriving (Eq, Ord, Show, Generic, NFData) + +-- The properties of a variable +data CFVariableProp = CFVPExport | CFVPArray + deriving (Eq, Ord, Show, Generic, NFData) + +-- Options when generating CFG +data CFGParameters = CFGParameters { + -- Whether the last element in a pipeline runs in the current shell + cfLastpipe :: Bool, + -- Whether all elements in a pipeline count towards the exit status + cfPipefail :: Bool +} + +data CFGResult = CFGResult { + -- The graph itself + cfGraph :: CFGraph, + -- Map from Id to start/end node + cfIdToNode :: M.Map Id (Node, Node) +} + deriving (Show) + +buildGraph :: CFGParameters -> Token -> CFGResult +buildGraph params root = + let + (nextNode, base) = execRWS (buildRoot root) (newCFContext params) 0 + (nodes, edges, mapping) = +-- renumberTopologically $ + removeUnnecessaryStructuralNodes + base + in + CFGResult { + cfGraph = mkGraph nodes edges, + cfIdToNode = M.fromList mapping + } + +remapGraph remap (nodes, edges, mapping) = + ( + map (remapNode remap) nodes, + map (remapEdge remap) edges, + map (\(id, (a,b)) -> (id, (remapHelper remap a, remapHelper remap b))) mapping + ) + +prop_testRenumbering = + let + s = CFStructuralNode + before = ( + [(1,s), (3,s), (4, s), (8,s)], + [(1,3,CFEFlow), (3,4, CFEFlow), (4,8,CFEFlow)], + [(Id 0, (3,4))] + ) + after = ( + [(0,s), (1,s), (2,s), (3,s)], + [(0,1,CFEFlow), (1,2, CFEFlow), (2,3,CFEFlow)], + [(Id 0, (1,2))] + ) + in after == renumberGraph before + +-- Renumber the graph for prettiness, so there are no gaps in node numbers +renumberGraph g@(nodes, edges, mapping) = + let renumbering = M.fromList (flip zip [0..] $ sort $ map fst nodes) + in remapGraph renumbering g + +prop_testRenumberTopologically = + let + s = CFStructuralNode + before = ( + [(4,s), (2,s), (3, s)], + [(4,2,CFEFlow), (2,3, CFEFlow)], + [(Id 0, (4,2))] + ) + after = ( + [(0,s), (1,s), (2,s)], + [(0,1,CFEFlow), (1,2, CFEFlow)], + [(Id 0, (0,1))] + ) + in after == renumberTopologically before + +-- Renumber the graph in topological order +renumberTopologically g@(nodes, edges, mapping) = + let renumbering = M.fromList (flip zip [0..] $ topsort (mkGraph nodes edges :: CFGraph)) + in remapGraph renumbering g + +prop_testRemoveStructural = + let + s = CFStructuralNode + before = ( + [(1,s), (2,s), (3, s), (4,s)], + [(1,2,CFEFlow), (2,3, CFEFlow), (3,4,CFEFlow)], + [(Id 0, (2,3))] + ) + after = ( + [(1,s), (2,s), (4,s)], + [(1,2,CFEFlow), (2,4,CFEFlow)], + [(Id 0, (2,2))] + ) + in after == removeUnnecessaryStructuralNodes before + +-- Collapse structural nodes that just form long chains like x->x->x. +-- This way we can generate them with abandon, without making DFA slower. +-- +-- Note in particular that we can't remove a structural node x in +-- foo -> x -> bar , because then the pre/post-condition for tokens +-- previously pointing to x would be wrong. +removeUnnecessaryStructuralNodes (nodes, edges, mapping) = + remapGraph recursiveRemapping + ( + filter (\(n, _) -> n `M.notMember` recursiveRemapping) nodes, + filter (`S.notMember` edgesToCollapse) edges, + mapping + ) + where + regularEdges = filter isRegularEdge edges + inDegree = counter $ map (\(from,to,_) -> from) regularEdges + outDegree = counter $ map (\(from,to,_) -> to) regularEdges + structuralNodes = S.fromList $ map fst $ filter isStructural nodes + candidateNodes = S.filter isLinear structuralNodes + edgesToCollapse = S.fromList $ filter filterEdges regularEdges + + remapping :: M.Map Node Node + remapping = foldl' (\m (new, old) -> M.insert old new m) M.empty $ map orderEdge $ S.toList edgesToCollapse + recursiveRemapping = M.fromList $ map (\c -> (c, recursiveLookup remapping c)) $ M.keys remapping + + filterEdges (a,b,_) = + a `S.member` candidateNodes && b `S.member` candidateNodes + + orderEdge (a,b,_) = if a < b then (a,b) else (b,a) + counter = foldl' (\map key -> M.insertWith (+) key 1 map) M.empty + isRegularEdge (_, _, CFEFlow) = True + isRegularEdge _ = False + + recursiveLookup :: M.Map Node Node -> Node -> Node + recursiveLookup map node = + case M.lookup node map of + Nothing -> node + Just x -> recursiveLookup map x + + isStructural (node, label) = + case label of + CFStructuralNode -> True + _ -> False + + isLinear node = + M.findWithDefault 0 node inDegree == 1 + && M.findWithDefault 0 node outDegree == 1 + + +remapNode :: M.Map Node Node -> LNode CFNode -> LNode CFNode +remapNode m (node, label) = + (remapHelper m node, newLabel) + where + newLabel = case label of + CFApplyEffects effects -> CFApplyEffects (map (remapEffect m) effects) + CFExecuteSubshell s a b -> CFExecuteSubshell s (remapHelper m a) (remapHelper m b) +-- CFSubShellStart reason node -> CFSubShellStart reason (remapHelper m node) + + _ -> label + +remapEffect map old@(IdTagged id effect) = + case effect of + CFDefineFunction name id start end -> IdTagged id $ CFDefineFunction name id (remapHelper map start) (remapHelper map end) + _ -> old + +remapEdge :: M.Map Node Node -> LEdge CFEdge -> LEdge CFEdge +remapEdge map (from, to, label) = (remapHelper map from, remapHelper map to, label) +remapHelper map n = M.findWithDefault n n map + +data Range = Range Node Node + deriving (Eq, Show) + +data CFContext = CFContext { + cfIsCondition :: Bool, + cfIsFunction :: Bool, + cfLoopStack :: [(Node, Node)], + cfExitTarget :: Maybe Node, + cfReturnTarget :: Maybe Node, + cfParameters :: CFGParameters +} +newCFContext params = CFContext { + cfIsCondition = False, + cfIsFunction = False, + cfLoopStack = [], + cfExitTarget = Nothing, + cfReturnTarget = Nothing, + cfParameters = params +} + +-- The monad we generate a graph in +type CFM a = RWS CFContext ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))]) Int a + +newNode :: CFNode -> CFM Node +newNode label = do + n <- get + put (n+1) + tell ([(n, label)], [], []) + return n + +newNodeRange :: CFNode -> CFM Range +-- newNodeRange label = nodeToRange <$> newNode label +newNodeRange label = nodeToRange <$> newNode label + +-- Build a disjoint piece of the graph and return a CFExecuteSubshell. The Id is used purely for debug naming. +subshell :: Id -> String -> CFM Range -> CFM Range +subshell id reason p = do + start <- newNode $ CFEntryPoint $ "Subshell " ++ show id ++ ": " ++ reason + end <- newNode CFStructuralNode + middle <- local (\c -> c { cfExitTarget = Just end, cfReturnTarget = Just end}) p + linkRanges [nodeToRange start, middle, nodeToRange end] + newNodeRange $ CFExecuteSubshell reason start end + + +withFunctionScope p = do + end <- newNode CFStructuralNode + body <- local (\c -> c { cfReturnTarget = Just end, cfIsFunction = True }) p + linkRanges [body, nodeToRange end] + + +nodeToRange :: Node -> Range +nodeToRange n = Range n n + +link :: Node -> Node -> CFEdge -> CFM () +link from to label = do + tell ([], [(from, to, label)], []) + +registerNode :: Id -> Range -> CFM () +registerNode id (Range start end) = tell ([], [], [(id, (start, end))]) + +linkRange :: Range -> Range -> CFM Range +linkRange = linkRangeAs CFEFlow + +linkRangeAs :: CFEdge -> Range -> Range -> CFM Range +linkRangeAs label (Range start mid1) (Range mid2 end) = do + link mid1 mid2 label + return (Range start end) + +-- Like linkRange but without actually linking +spanRange :: Range -> Range -> Range +spanRange (Range start mid1) (Range mid2 end) = Range start end + +linkRanges :: [Range] -> CFM Range +linkRanges [] = error "Empty range" +linkRanges (first:rest) = foldM linkRange first rest + +sequentially :: [Token] -> CFM Range +sequentially list = do + first <- newStructuralNode + rest <- mapM build list + linkRanges (first:rest) + +withContext :: (CFContext -> CFContext) -> CFM a -> CFM a +withContext = local + +withReturn :: Range -> CFM a -> CFM a +withReturn _ p = p + +asCondition :: CFM Range -> CFM Range +asCondition = withContext (\c -> c { cfIsCondition = True }) + +newStructuralNode = newNodeRange CFStructuralNode + +buildRoot :: Token -> CFM Range +buildRoot t = do + entry <- newNodeRange $ CFEntryPoint "MAIN" + impliedExit <- newNode CFImpliedExit + end <- newNode CFStructuralNode + start <- local (\c -> c { cfExitTarget = Just end, cfReturnTarget = Just impliedExit}) $ build t + range <- linkRanges [entry, start, nodeToRange impliedExit, nodeToRange end] + registerNode (getId t) range + return range + +applySingle e = CFApplyEffects [e] + +-- Build the CFG. +build :: Token -> CFM Range +build t = do + range <- build' t + registerNode (getId t) range + return range + where + build' t = case t of + T_Annotation _ _ list -> build list + T_Script _ _ list -> do + sequentially list + + TA_Assignment id op var@(TA_Variable _ name indices) rhs -> do + -- value first: (( var[x=1] = (x=2) )) runs x=1 last + value <- build rhs + subscript <- sequentially indices + read <- + if op == "=" + then none + -- This is += or something + else newNodeRange $ applySingle $ IdTagged id $ CFReadVariable name + + write <- newNodeRange $ applySingle $ IdTagged id $ CFWriteVariable name $ + if null indices + then CFValueInteger + else CFValueArray + + linkRanges [value, subscript, read, write] + + TA_Assignment id op lhs rhs -> do + -- This is likely an invalid assignment like (( 1 = 2 )), but it + -- could be e.g. x=y; (( $x = 3 )); echo $y, so expand both sides + -- without updating anything + sequentially [lhs, rhs] + + TA_Binary _ _ a b -> sequentially [a,b] + TA_Expansion _ list -> sequentially list + TA_Sequence _ list -> sequentially list + + TA_Trinary _ cond a b -> do + condition <- build cond + ifthen <- build a + elsethen <- build b + end <- newStructuralNode + linkRanges [condition, ifthen, end] + linkRanges [condition, elsethen, end] + + TA_Variable id name indices -> do + subscript <- sequentially indices + hint <- + if null indices + then none + else nodeToRange <$> newNode (applySingle $ IdTagged id $ CFHintArray name) + read <- nodeToRange <$> newNode (applySingle $ IdTagged id $ CFReadVariable name) + linkRanges [subscript, hint, read] + + TA_Unary id op (TA_Variable _ name indices) | "--" `isInfixOf` op || "++" `isInfixOf` op -> do + subscript <- sequentially indices + read <- newNodeRange $ applySingle $ IdTagged id $ CFReadVariable name + write <- newNodeRange $ applySingle $ IdTagged id $ CFWriteVariable name $ + if null indices + then CFValueInteger + else CFValueArray + linkRanges [subscript, read, write] + TA_Unary _ _ arg -> build arg + + TC_And _ SingleBracket _ lhs rhs -> do + sequentially [lhs, rhs] + + TC_And _ DoubleBracket _ lhs rhs -> do + left <- build lhs + right <- build rhs + end <- newStructuralNode + -- complete + linkRanges [left, right, end] + -- short circuit + linkRange left end + + -- TODO: Handle integer ops + TC_Binary _ mode str lhs rhs -> do + left <- build lhs + right <- build rhs + linkRange left right + + TC_Empty {} -> newStructuralNode + + TC_Group _ _ t -> build t + + -- TODO: Mark as checked + TC_Nullary _ _ arg -> build arg + + TC_Or _ SingleBracket _ lhs rhs -> sequentially [lhs, rhs] + + TC_Or _ DoubleBracket _ lhs rhs -> do + left <- build lhs + right <- build rhs + end <- newStructuralNode + -- complete + linkRanges [left, right, end] + -- short circuit + linkRange left end + + -- TODO: Handle -v, -z, -n + TC_Unary _ _ op arg -> do + build arg + + T_Arithmetic id root -> do + exe <- build root + status <- newNodeRange (CFSetExitCode id) + linkRange exe status + + T_AndIf _ lhs rhs -> do + left <- build lhs + right <- build rhs + end <- newStructuralNode + linkRange left right + linkRange right end + linkRange left end + + T_Array _ list -> sequentially list + + T_Assignment {} -> buildAssignment DefaultScope t + + T_Backgrounded id body -> do + start <- newStructuralNode + fork <- subshell id "backgrounding '&'" $ build body + pid <- newNodeRange $ CFSetBackgroundPid id + status <- newNodeRange $ CFSetExitCode id + + linkRange start fork + -- Add a join from the fork to warn about variable changes + linkRangeAs CFEFalseFlow fork pid + linkRanges [start, pid, status] + + T_Backticked id body -> + subshell id "`..` expansion" $ sequentially body + + T_Banged id cmd -> do + main <- build cmd + status <- newNodeRange (CFSetExitCode id) + linkRange main status + + T_BatsTest id _ body -> do + -- These are technically set by the 'run' command, but we'll just define them + -- up front to avoid figuring out which commands named "run" belong to Bats. + status <- newNodeRange $ applySingle $ IdTagged id $ CFWriteVariable "status" CFValueInteger + output <- newNodeRange $ applySingle $ IdTagged id $ CFWriteVariable "output" CFValueString + main <- build body + linkRanges [status, output, main] + + T_BraceExpansion _ list -> sequentially list + + T_BraceGroup id body -> + sequentially body + + T_CaseExpression id t [] -> build t + + T_CaseExpression id t list -> do + start <- newStructuralNode + token <- build t + branches <- mapM buildBranch list + end <- newStructuralNode + + let neighbors = zip branches $ tail branches + let (_, firstCond, _) = head branches + let (_, lastCond, lastBody) = last branches + + linkRange start token + linkRange token firstCond + mapM_ (uncurry $ linkBranch end) neighbors + linkRange lastBody end + + unless (any hasCatchAll list) $ + -- There's no *) branch, so assume we can fall through + void $ linkRange token end + + return $ spanRange start end + + where + -- for a | b | c, evaluate each in turn and allow short circuiting + buildCond list = do + start <- newStructuralNode + conds <- mapM build list + end <- newStructuralNode + linkRanges (start:conds) + mapM_ (`linkRange` end) conds + return $ spanRange start end + + buildBranch (typ, cond, body) = do + c <- buildCond cond + b <- sequentially body + linkRange c b + return (typ, c, b) + + linkBranch end (typ, cond, body) (_, nextCond, nextBody) = do + -- Failure case + linkRange cond nextCond + -- After body + case typ of + CaseBreak -> linkRange body end + CaseFallThrough -> linkRange body nextBody + CaseContinue -> linkRange body nextCond + + -- Find a *) if any + + hasCatchAll (_,cond,_) = any isCatchAll cond + isCatchAll c = fromMaybe False $ do + pg <- wordToExactPseudoGlob c + return $ pg `pseudoGlobIsSuperSetof` [PGMany] + + T_Condition _ _ op -> build op + + T_CoProc id maybeName t -> do + let name = fromMaybe "COPROC" maybeName + start <- newStructuralNode + parent <- newNodeRange $ applySingle $ IdTagged id $ CFWriteVariable name CFValueArray + child <- subshell id "coproc" $ build t + end <- newNodeRange $ CFSetExitCode id + + linkRange start parent + linkRange start child + linkRange parent end + linkRangeAs CFEFalseFlow child end + + return $ spanRange start end + T_CoProcBody _ t -> build t + + T_DollarArithmetic _ arith -> build arith + T_DollarDoubleQuoted _ list -> sequentially list + T_DollarSingleQuoted _ _ -> none + T_DollarBracket _ t -> build t + + T_DollarBraced id _ t -> do + let str = concat $ oversimplify t + let modifier = getBracedModifier str + let reference = getBracedReference str + let indices = getIndexReferences str + let offsets = getOffsetReferences str + vals <- build t + others <- mapM (\x -> nodeToRange <$> newNode (applySingle $ IdTagged id $ CFReadVariable x)) (indices ++ offsets) + deps <- linkRanges (vals:others) + read <- nodeToRange <$> newNode (applySingle $ IdTagged id $ CFReadVariable reference) + totalRead <- linkRange deps read + + if any (`isPrefixOf` modifier) ["=", ":="] + then do + optionalAssign <- newNodeRange (applySingle $ IdTagged id $ CFWriteVariable reference CFValueString) + result <- newStructuralNode + linkRange optionalAssign result + linkRange totalRead result + else return totalRead + + T_DoubleQuoted _ list -> sequentially list + + T_DollarExpansion id body -> + subshell id "$(..) expansion" $ sequentially body + + T_Extglob _ _ list -> sequentially list + + T_FdRedirect id ('{':identifier) op -> do + let name = takeWhile (/= '}') identifier + expression <- build op + rw <- newNodeRange $ + if isClosingFileOp op + then applySingle $ IdTagged id $ CFReadVariable name + else applySingle $ IdTagged id $ CFWriteVariable name CFValueInteger + + linkRange expression rw + + + T_FdRedirect _ name t -> do + build t + + T_ForArithmetic _ initT condT incT bodyT -> do + init <- build initT + cond <- build condT + body <- sequentially bodyT + inc <- build incT + end <- newStructuralNode + + -- Forward edges + linkRanges [init, cond, body, inc] + linkRange cond end + -- Backward edge + linkRange inc cond + return $ spanRange init end + + T_ForIn id name words body -> forInHelper id name words body + + -- For functions we generate an unlinked subgraph, and mention that in its definition node + T_Function id _ _ name body -> do + range <- local (\c -> c { cfExitTarget = Nothing }) $ do + entry <- newNodeRange $ CFEntryPoint $ "function " ++ name + f <- withFunctionScope $ build body + linkRange entry f + let (Range entry exit) = range + definition <- newNodeRange (applySingle $ IdTagged id $ CFDefineFunction name id entry exit) + exe <- newNodeRange (CFSetExitCode id) + linkRange definition exe + + T_Glob {} -> none + + T_HereString _ t -> build t + T_HereDoc _ _ _ _ list -> sequentially list + + T_IfExpression id ifs elses -> do + start <- newStructuralNode + branches <- doBranches start ifs elses [] + end <- newStructuralNode + mapM_ (`linkRange` end) branches + return $ spanRange start end + where + doBranches start ((conds, thens):rest) elses result = do + cond <- asCondition $ sequentially conds + action <- sequentially thens + linkRange start cond + linkRange cond action + doBranches cond rest elses (action:result) + doBranches start [] elses result = do + rest <- + if null elses + then newNodeRange (CFSetExitCode id) + else sequentially elses + linkRange start rest + return (rest:result) + + T_Include _ t -> build t + + T_IndexedElement _ indicesT valueT -> do + indices <- sequentially indicesT + value <- build valueT + linkRange indices value + + T_IoDuplicate _ op _ -> build op + + T_IoFile _ op t -> do + exp <- build t + doesntDoMuch <- build op + linkRange exp doesntDoMuch + + T_Literal {} -> none + + T_NormalWord _ list -> sequentially list + + T_OrIf _ lhs rhs -> do + left <- build lhs + right <- build rhs + end <- newStructuralNode + linkRange left right + linkRange right end + linkRange left end + + T_Pipeline _ _ [cmd] -> build cmd + T_Pipeline id _ cmds -> do + start <- newStructuralNode + hasLastpipe <- reader $ cfLastpipe . cfParameters + (leading, last) <- buildPipe hasLastpipe cmds + end <- newStructuralNode + + mapM_ (linkRange start) leading + mapM_ (\c -> linkRangeAs CFEFalseFlow c end) leading + linkRanges $ [start] ++ last ++ [end] + where + buildPipe True [x] = do + last <- build x + return ([], [last]) + buildPipe lp (first:rest) = do + this <- subshell id "pipeline" $ build first + (leading, last) <- buildPipe lp rest + return (this:leading, last) + buildPipe _ [] = return ([], []) + + T_ProcSub id op cmds -> do + start <- newStructuralNode + body <- subshell id (op ++ "() process substitution") $ sequentially cmds + end <- newStructuralNode + + linkRange start body + linkRangeAs CFEFalseFlow body end + linkRange start end + + T_Redirecting _ redirs cmd -> do + -- For simple commands, this is the other way around in bash + -- We do it in this order for comound commands like { x=name; } > "$x" + redir <- sequentially redirs + body <- build cmd + linkRange redir body + + T_SelectIn id name words body -> forInHelper id name words body + + T_SimpleCommand id vars [] -> do + -- Vars can also be empty, as in the command "> foo" + assignments <- sequentially vars + status <- newNodeRange (CFSetExitCode id) + linkRange assignments status + + T_SimpleCommand id vars list@(cmd:_) -> + handleCommand t vars list $ getUnquotedLiteral cmd + + T_SingleQuoted _ _ -> none + + T_SourceCommand _ originalCommand inlinedSource -> do + cmd <- build originalCommand + end <- newStructuralNode + inline <- withReturn end $ build inlinedSource + linkRange cmd inline + linkRange inline end + return $ spanRange cmd inline + + T_Subshell id body -> do + main <- subshell id "explicit (..) subshell" $ sequentially body + status <- newNodeRange (CFSetExitCode id) + linkRange main status + + T_UntilExpression id cond body -> whileHelper id cond body + T_WhileExpression id cond body -> whileHelper id cond body + + T_CLOBBER _ -> none + T_GREATAND _ -> none + T_LESSAND _ -> none + T_LESSGREAT _ -> none + T_DGREAT _ -> none + T_Greater _ -> none + T_Less _ -> none + T_ParamSubSpecialChar _ _ -> none + + x -> error ("Unimplemented: " ++ show x) + +-- Still in `where` clause + forInHelper id name words body = do + entry <- newStructuralNode + expansion <- sequentially words + assignmentChoice <- newStructuralNode + assignments <- + if null words || any willSplit words + then (:[]) <$> (newNodeRange $ applySingle $ IdTagged id $ CFWriteVariable name CFValueString) + else mapM (\t -> newNodeRange $ applySingle $ IdTagged id $ CFWriteVariable name $ CFValueComputed (getId t) $ tokenToParts t) words + body <- sequentially body + exit <- newStructuralNode + -- Forward edges + linkRanges [entry, expansion, assignmentChoice] + mapM_ (\t -> linkRanges [assignmentChoice, t, body]) assignments + linkRange body exit + linkRange expansion exit + -- Backward edge + linkRange body assignmentChoice + return $ spanRange entry exit + + whileHelper id cond body = do + condRange <- asCondition $ sequentially cond + bodyRange <- sequentially body + end <- newNodeRange (CFSetExitCode id) + + linkRange condRange bodyRange + linkRange bodyRange condRange + linkRange condRange end + + +handleCommand cmd vars args literalCmd = do + -- TODO: Handle assignments in declaring commands + + case literalCmd of + Just "exit" -> regularExpansion vars args $ handleExit + Just "return" -> regularExpansion vars args $ handleReturn + Just "unset" -> regularExpansionWithStatus vars args $ handleUnset args + + Just "declare" -> handleDeclare args + Just "local" -> handleDeclare args + Just "typeset" -> handleDeclare args + + Just "printf" -> regularExpansionWithStatus vars args $ handlePrintf args + Just "wait" -> regularExpansionWithStatus vars args $ handleWait args + + Just "mapfile" -> regularExpansionWithStatus vars args $ handleMapfile args + Just "readarray" -> regularExpansionWithStatus vars args $ handleMapfile args + + Just "DEFINE_boolean" -> regularExpansionWithStatus vars args $ handleDEFINE args + Just "DEFINE_float" -> regularExpansionWithStatus vars args $ handleDEFINE args + Just "DEFINE_integer" -> regularExpansionWithStatus vars args $ handleDEFINE args + Just "DEFINE_string" -> regularExpansionWithStatus vars args $ handleDEFINE args + + -- This will mostly behave like 'command' but ok + Just "builtin" -> + case args of + [_] -> regular + (_:newargs@(newcmd:_)) -> + handleCommand newcmd vars newargs $ getLiteralString newcmd + Just "command" -> + case args of + [_] -> regular + (_:newargs@(newcmd:_)) -> + handleOthers (getId newcmd) vars newargs $ getLiteralString newcmd + _ -> regular + + where + regular = handleOthers (getId cmd) vars args literalCmd + handleExit = do + exitNode <- reader cfExitTarget + case exitNode of + Just target -> do + exit <- newNode CFResolvedExit + link exit target CFEExit + unreachable <- newNode CFUnreachable + return $ Range exit unreachable + Nothing -> do + exit <- newNode CFUnresolvedExit + unreachable <- newNode CFUnreachable + return $ Range exit unreachable + + handleReturn = do + returnTarget <- reader cfReturnTarget + case returnTarget of + Nothing -> error $ pleaseReport "missing return target" + Just target -> do + ret <- newNode CFStructuralNode + link ret target CFEFlow + unreachable <- newNode CFUnreachable + return $ Range ret unreachable + + handleUnset (cmd:args) = do + case () of + _ | "n" `elem` flagNames -> unsetWith CFUndefineNameref + _ | "v" `elem` flagNames -> unsetWith CFUndefineVariable + _ | "f" `elem` flagNames -> unsetWith CFUndefineFunction + _ -> unsetWith CFUndefine + where + pairs :: [(String, Token)] -- [(Flag string, token)] e.g. [("-f", t), ("", myfunc)] + pairs = map (\(str, (flag, val)) -> (str, flag)) $ fromMaybe (map (\c -> ("", (c,c))) args) $ getGnuOpts "vfn" args + (names, flags) = partition (null . fst) pairs + flagNames = map fst flags + literalNames :: [(Token, String)] -- Literal names to unset, e.g. [(myfuncToken, "myfunc")] + literalNames = mapMaybe (\(_, t) -> getLiteralString t >>= (return . (,) t)) names + -- Apply a constructor like CFUndefineVariable to each literalName, and tag with its id + unsetWith c = newNodeRange $ CFApplyEffects $ map (\(token, name) -> IdTagged (getId token) $ c name) literalNames + + + variableAssignRegex = mkRegex "^([_a-zA-Z][_a-zA-Z0-9]*)=" + + handleDeclare (cmd:args) = do + isFunc <- asks cfIsFunction + let (evaluated, effects) = mconcat $ map (toEffects isFunc) args + before <- sequentially $ evaluated + effect <- newNodeRange $ CFApplyEffects effects + result <- newNodeRange $ CFSetExitCode (getId cmd) + linkRanges [before, effect, result] + where + opts = map fst $ getGenericOpts args + array = "a" `elem` opts || "A" `elem` opts + integer = "i" `elem` opts + func = "f" `elem` opts || "F" `elem` opts + global = "g" `elem` opts + writer isFunc = + case () of + _ | global -> CFWriteGlobal + _ | isFunc -> CFWriteLocal + _ -> CFWriteVariable + + toEffects :: Bool -> Token -> ([Token], [IdTagged CFEffect]) + toEffects isFunc (T_Assignment id mode var idx t) = + let + pre = idx ++ [t] + isArray = array || (not $ null idx) + asArray = [ IdTagged id $ (writer isFunc) var CFValueArray ] + asString = [ IdTagged id $ (writer isFunc) var $ + if integer + then CFValueInteger -- TODO: Also handle integer variable property + else CFValueComputed (getId t) $ [ CFStringVariable var | mode == Append ] ++ tokenToParts t + ] + in + (pre, if isArray then asArray else asString ) + + toEffects isFunc t = + let + pre = [t] + literal = fromJust $ getLiteralStringExt (const $ Just "\0") t + isKnown = '\0' `notElem` literal + match = fmap head $ variableAssignRegex `matchRegex` literal + name = fromMaybe literal match + + typer def = + if array + then CFValueArray + else + if integer + then CFValueInteger + else def + + asLiteral = [ + IdTagged (getId t) $ (writer isFunc) name $ + typer $ CFValueComputed (getId t) [ CFStringLiteral $ drop 1 $ dropWhile (/= '=') $ literal ] + ] + asUnknown = [ + IdTagged (getId t) $ (writer isFunc) name $ + typer $ CFValueString + ] + asBlank = [ + IdTagged (getId t) $ (writer isFunc) name $ + typer $ CFValueComputed (getId t) [] + ] + in + case () of + _ | not (isVariableName name) -> (pre, []) + _ | isJust match && isKnown -> (pre, asLiteral) + _ | isJust match -> (pre, asUnknown) + _ -> (pre, asBlank) + + handlePrintf (cmd:args) = + newNodeRange $ CFApplyEffects $ maybeToList findVar + where + findVar = do + flags <- getBsdOpts "v:" args + (flag, arg) <- lookup "v" flags + name <- getLiteralString arg + return $ IdTagged (getId arg) $ CFWriteVariable name CFValueString + + handleWait (cmd:args) = + newNodeRange $ CFApplyEffects $ maybeToList findVar + where + findVar = do + let flags = getGenericOpts args + (flag, arg) <- lookup "p" flags + name <- getLiteralString arg + return $ IdTagged (getId arg) $ CFWriteVariable name CFValueInteger + + handleMapfile (cmd:args) = + newNodeRange $ CFApplyEffects [findVar] + where + findVar = + let (id, name) = fromMaybe (getId cmd, "MAPFILE") $ getFromArg `mplus` getFromFallback + in IdTagged id $ CFWriteVariable name CFValueArray + + getFromArg = do + flags <- getGnuOpts "d:n:O:s:u:C:c:t" args + (_, arg) <- lookup "" flags + name <- getLiteralString arg + return (getId arg, name) + + getFromFallback = + listToMaybe $ mapMaybe getIfVar $ reverse args + getIfVar c = do + name <- getLiteralString c + guard $ isVariableName name + return (getId c, name) + + handleDEFINE (cmd:args) = + newNodeRange $ CFApplyEffects $ maybeToList findVar + where + findVar = do + name <- listToMaybe $ drop 1 args + str <- getLiteralString name + guard $ isVariableName str + return $ IdTagged (getId name) $ CFWriteVariable str CFValueString + + handleOthers id vars args cmd = + regularExpansion vars args $ do + exe <- newNodeRange $ CFExecuteCommand cmd + status <- newNodeRange $ CFSetExitCode id + linkRange exe status + + regularExpansion vars args p = do + args <- sequentially args + assignments <- mapM (buildAssignment PrefixScope) vars + exe <- p + dropAssignments <- + if null vars + then + return [] + else do + drop <- newNodeRange CFDropPrefixAssignments + return [drop] + + linkRanges $ [args] ++ assignments ++ [exe] ++ dropAssignments + + regularExpansionWithStatus vars args@(cmd:_) p = do + initial <- regularExpansion vars args p + status <- newNodeRange $ CFSetExitCode (getId cmd) + linkRange initial status + + +none = newStructuralNode + +data Scope = DefaultScope | GlobalScope | LocalScope | PrefixScope + +buildAssignment scope t = do + op <- case t of + T_Assignment id mode var indices value -> do + expand <- build value + index <- sequentially indices + read <- case mode of + Append -> newNodeRange (applySingle $ IdTagged id $ CFReadVariable var) + Assign -> none + let valueType = if null indices then f id value else CFValueArray + let scoper = + case scope of + PrefixScope -> CFWritePrefix + LocalScope -> CFWriteLocal + GlobalScope -> CFWriteGlobal + DefaultScope -> CFWriteVariable + write <- newNodeRange $ applySingle $ IdTagged id $ scoper var valueType + linkRanges [expand, index, read, write] + where + f :: Id -> Token -> CFValue + f id t@T_NormalWord {} = CFValueComputed id $ [CFStringVariable var | mode == Append] ++ tokenToParts t + f id t@(T_Literal _ str) = CFValueComputed id $ [CFStringVariable var | mode == Append] ++ tokenToParts t + f _ T_Array {} = CFValueArray + + registerNode (getId t) op + return op + + +tokenToParts t = + case t of + T_NormalWord _ list -> concatMap tokenToParts list + T_DoubleQuoted _ list -> concatMap tokenToParts list + T_SingleQuoted _ str -> [ CFStringLiteral str ] + T_Literal _ str -> [ CFStringLiteral str ] + T_DollarArithmetic {} -> [ CFStringInteger ] + T_DollarBracket {} -> [ CFStringInteger ] + T_DollarBraced _ _ list | isUnmodifiedParameterExpansion t -> [ CFStringVariable (getBracedReference $ concat $ oversimplify list) ] + -- Check if getLiteralString can handle it, if not it's unknown + _ -> [maybe CFStringUnknown CFStringLiteral $ getLiteralString t] + +return [] +runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs new file mode 100644 index 0000000..99ce450 --- /dev/null +++ b/src/ShellCheck/CFGAnalysis.hs @@ -0,0 +1,1113 @@ +{- + Copyright 2022 Vidar Holen + + This file is part of ShellCheck. + https://www.shellcheck.net + + ShellCheck is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + ShellCheck is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-} + +{- + Data Flow Analysis on a Control Flow Graph. + + This module implements a pretty standard iterative Data Flow Analysis. + For an overview of the process, see Wikipedia. + + Since shell scripts rely heavily on global variables, this DFA includes + tracking the value of globals across calls. Each function invocation is + treated as a separate DFA problem, and a caching mechanism (hopefully) + avoids any exponential explosions. + + To do efficient DFA join operations (or merges, as the code calls them), + some of the data structures have an integer version attached. On update, + the version is changed. If two states have the same version number, + a merge is skipped on the grounds that they are identical. It is easy + to unintentionally forget to update/invalidate the version number, + and bugs will ensure. + + For performance reasons, the entire code runs in plain ST, with a manual + context object Ctx being passed around. It relies heavily on mutable + STRefs. However, this turned out to be literally thousands of times faster + than my several attempts using RWST, so it can't be helped. +-} + +module ShellCheck.CFGAnalysis ( + analyzeControlFlow + ,CFGParameters (..) + ,CFGAnalysis (..) + ,ProgramState (..) + ,VariableValue (..) + ,SpaceStatus (..) + ,getIncomingState + ,getOutgoingState + ,ShellCheck.CFGAnalysis.runTests -- STRIP + ) where + +import GHC.Generics (Generic) +import ShellCheck.AST +import ShellCheck.CFG +import qualified ShellCheck.Data as Data +import ShellCheck.Prelude +import Control.Monad +import Control.Monad.ST +import Control.DeepSeq +import Data.List hiding (map) +import Data.STRef +import Data.Maybe +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Graph.Inductive.Graph +import Data.Graph.Inductive.Query.DFS +import Debug.Trace -- STRIP + +import Test.QuickCheck + + +iterationCount = 1000000 +cacheEntries = 10 + +-- The result of the data flow analysis +data CFGAnalysis = CFGAnalysis { + graph :: CFGraph, + tokenToNode :: M.Map Id (Node, Node), + nodeToData :: M.Map Node (ProgramState, ProgramState) +} deriving (Show, Generic, NFData) + +-- The program state we expose externally +data ProgramState = ProgramState { + variablesInScope :: M.Map String VariableValue, + stateIsReachable :: Bool +-- internalState :: InternalState +} deriving (Show, Eq, Generic, NFData) + +-- Conveniently get the state before a token id +getIncomingState :: CFGAnalysis -> Id -> Maybe ProgramState +getIncomingState analysis id = do + (start,end) <- M.lookup id $ tokenToNode analysis + fst <$> M.lookup start (nodeToData analysis) + +-- Conveniently get the state after a token id +getOutgoingState :: CFGAnalysis -> Id -> Maybe ProgramState +getOutgoingState analysis id = do + (start,end) <- M.lookup id $ tokenToNode analysis + snd <$> M.lookup end (nodeToData analysis) + +getDataForNode analysis node = M.lookup node $ nodeToData analysis + +-- The current state of data flow at a point in the program, potentially as a diff +data InternalState = InternalState { + sVersion :: Integer, + sGlobalValues :: VersionedMap String VariableValue, + sLocalValues :: VersionedMap String VariableValue, + sPrefixValues :: VersionedMap String VariableValue, + sFunctionTargets :: VersionedMap String FunctionValue, + sIsReachable :: Maybe Bool +} deriving (Show, Generic, NFData) + +newInternalState = InternalState { + sVersion = 0, + sGlobalValues = vmEmpty, + sLocalValues = vmEmpty, + sPrefixValues = vmEmpty, + sFunctionTargets = vmEmpty, + sIsReachable = Nothing +} + +unreachableState = modified newInternalState { + sIsReachable = Just False +} + +-- The default state we assume we get from the environment +createEnvironmentState :: InternalState +createEnvironmentState = do + foldl' (flip ($)) newInternalState $ concat [ + addVars Data.internalVariables unknownVariableValue, + addVars Data.variablesWithoutSpaces spacelessVariableValue, + addVars Data.specialIntegerVariables spacelessVariableValue + ] + where + addVars names val = map (\name -> insertGlobal name val) names + spacelessVariableValue = VariableValue { + literalValue = Nothing, + spaceStatus = SpaceStatusClean + } + + +modified s = s { sVersion = -1 } + +insertGlobal :: String -> VariableValue -> InternalState -> InternalState +insertGlobal name value state = modified state { + sGlobalValues = vmInsert name value $ sGlobalValues state +} + +insertLocal :: String -> VariableValue -> InternalState -> InternalState +insertLocal name value state = modified state { + sLocalValues = vmInsert name value $ sLocalValues state +} + +insertPrefix :: String -> VariableValue -> InternalState -> InternalState +insertPrefix name value state = modified state { + sPrefixValues = vmInsert name value $ sPrefixValues state +} + +insertFunction :: String -> FunctionValue -> InternalState -> InternalState +insertFunction name value state = modified state { + sFunctionTargets = vmInsert name value $ sFunctionTargets state +} + +internalToExternal :: InternalState -> ProgramState +internalToExternal s = + ProgramState { + -- Avoid introducing dependencies on the literal value as this is only for debugging purposes right now + variablesInScope = M.map (\c -> c { literalValue = Nothing }) flatVars, + -- internalState = s, -- For debugging + stateIsReachable = fromMaybe True $ sIsReachable s + } + where + flatVars = M.unionsWith (\_ last -> last) $ map mapStorage [sGlobalValues s, sLocalValues s, sPrefixValues s] + +-- Dependencies on values, e.g. "if there is a global variable named 'foo' without spaces" +-- This is used to see if the DFA of a function would result in the same state, so anything +-- that affects DFA must be tracked. +data StateDependency = + DepGlobalValue String VariableValue + | DepLocalValue String VariableValue + | DepPrefixValue String VariableValue + | DepFunction String (S.Set FunctionDefinition) + -- Whether invoking the node would result in recursion (i.e., is the function on the stack?) + | DepIsRecursive Node Bool + deriving (Show, Eq, Ord, Generic, NFData) + +-- A function definition, or lack thereof +data FunctionDefinition = FunctionUnknown | FunctionDefinition String Node Node + deriving (Show, Eq, Ord, Generic, NFData) + +-- The Set of places a command name can point (it's a Set to handle conditionally defined functions) +type FunctionValue = S.Set FunctionDefinition + +-- The scope of a function. ("Prefix" refers to e.g. `foo=1 env`) +data VariableScope = PrefixVar | LocalVar | GlobalVar + deriving (Show, Eq, Ord, Generic, NFData) + +-- Create an InternalState that fulfills the given dependencies +depsToState :: S.Set StateDependency -> InternalState +depsToState set = foldl insert newInternalState $ S.toList set + where + insert :: InternalState -> StateDependency -> InternalState + insert state dep = + case dep of + DepFunction name val -> insertFunction name val state + DepGlobalValue name val -> insertGlobal name val state + DepLocalValue name val -> insertLocal name val state + DepPrefixValue name val -> insertPrefix name val state + DepIsRecursive _ _ -> state + +unknownFunctionValue = S.singleton FunctionUnknown + +-- The information about the value of a single variable +data VariableValue = VariableValue { + literalValue :: Maybe String, -- TODO: For debugging. Remove me. + spaceStatus :: SpaceStatus +} + deriving (Show, Eq, Ord, Generic, NFData) + +-- Whether or not the value needs quoting (has spaces/globs), or we don't know +data SpaceStatus = SpaceStatusEmpty | SpaceStatusClean | SpaceStatusDirty deriving (Show, Eq, Ord, Generic, NFData) + + +unknownVariableValue = VariableValue { + literalValue = Nothing, + spaceStatus = SpaceStatusDirty +} + +emptyVariableValue = VariableValue { + literalValue = Just "", + spaceStatus = SpaceStatusEmpty +} + +mergeVariableValue a b = VariableValue { + literalValue = if literalValue a == literalValue b then literalValue a else Nothing, + spaceStatus = mergeSpaceStatus (spaceStatus a) (spaceStatus b) +} + +mergeSpaceStatus a b = + case (a,b) of + (SpaceStatusEmpty, y) -> y + (x, SpaceStatusEmpty) -> x + (SpaceStatusClean, SpaceStatusClean) -> SpaceStatusClean + _ -> SpaceStatusDirty + +-- A VersionedMap is a Map that keeps an additional integer version to quickly determine if it has changed. +-- * Version -1 means it's unknown (possibly and presumably changed) +-- * Version 0 means it's empty +-- * Version N means it's equal to any other map with Version N (this is required but not enforced) +data VersionedMap k v = VersionedMap { + mapVersion :: Integer, + mapStorage :: M.Map k v +} + deriving (Generic, NFData) + +-- This makes states more readable but inhibits copy-paste +instance (Show k, Show v) => Show (VersionedMap k v) where + show m = (if mapVersion m >= 0 then "V" ++ show (mapVersion m) else "U") ++ " " ++ show (mapStorage m) + +instance Eq InternalState where + (==) a b = stateIsQuickEqual a b || stateIsSlowEqual a b + +instance (Eq k, Eq v) => Eq (VersionedMap k v) where + (==) a b = vmIsQuickEqual a b || mapStorage a == mapStorage b + +instance (Ord k, Ord v) => Ord (VersionedMap k v) where + compare a b = + if vmIsQuickEqual a b + then EQ + else mapStorage a `compare` mapStorage b + + +-- A context with STRefs manually passed around to function. +-- This is done because it was dramatically much faster than any RWS type stack +data Ctx s = Ctx { + -- The current node + cNode :: STRef s Node, + -- The current input state + cInput :: STRef s InternalState, + -- The current output state + cOutput :: STRef s InternalState, + + -- The current functions/subshells stack + cStack :: [StackEntry s], + -- The input graph + cGraph :: CFGraph, + -- An incrementing counter to version maps + cCounter :: STRef s Integer, + -- A cache of input state dependencies to output effects + cCache :: STRef s (M.Map Node [(S.Set StateDependency, InternalState)]), + -- The states resulting from data flows per invocation path + cInvocations :: STRef s (M.Map [Node] (S.Set StateDependency, M.Map Node (InternalState, InternalState))) +} + +-- Whenever a function (or subshell) is invoked, a value like this is pushed onto the stack +data StackEntry s = StackEntry { + -- The entry point of this stack entry for the purpose of detecting recursion + entryPoint :: Node, + -- The node where this entry point was invoked + callSite :: Node, + -- A mutable set of dependencies we fetched from here or higher in the stack + dependencies :: STRef s (S.Set StateDependency), + -- The original input state for this stack entry + stackState :: InternalState +} + deriving (Eq, Generic, NFData) + + +-- Overwrite a base state with the contents of a diff state +-- This is unrelated to join/merge. +patchState :: InternalState -> InternalState -> InternalState +patchState base diff = + case () of + _ | sVersion diff == 0 -> base + _ | sVersion base == 0 -> diff + _ | stateIsQuickEqual base diff -> diff + _ -> + InternalState { + sVersion = -1, + sGlobalValues = vmPatch (sGlobalValues base) (sGlobalValues diff), + sLocalValues = vmPatch (sLocalValues base) (sLocalValues diff), + sPrefixValues = vmPatch (sPrefixValues base) (sPrefixValues diff), + sFunctionTargets = vmPatch (sFunctionTargets base) (sFunctionTargets diff), + sIsReachable = sIsReachable diff `mplus` sIsReachable base + } + +patchOutputM ctx diff = do + let cOut = cOutput ctx + oldState <- readSTRef cOut + let newState = patchState oldState diff + writeSTRef cOut newState + +-- Merge (aka Join) two states. This is monadic because it requires looking up +-- values from the current context. For example: +-- +-- f() { +-- foo || x=2 +-- HERE # This merge requires looking up the value of $x in the parent frame +-- } +-- x=1 +-- f +mergeState :: forall s. Ctx s -> InternalState -> InternalState -> ST s InternalState +mergeState ctx a b = do + -- Kludge: we want `readVariable` & friends not to read from an intermediate state, + -- so temporarily set a blank input. + let cin = cInput ctx + old <- readSTRef cin + writeSTRef cin newInternalState + x <- merge a b + writeSTRef cin old + return x + + where + + merge a b = + case () of + _ | sIsReachable a == Just True && sIsReachable b == Just False + || sIsReachable a == Just False && sIsReachable b == Just True -> + error $ pleaseReport "Unexpected merge of reachable and unreachable state" + _ | sIsReachable a == Just False && sIsReachable b == Just False -> + return unreachableState + _ | sVersion a >= 0 && sVersion b >= 0 && sVersion a == sVersion b -> return a + _ -> do + globals <- mergeMaps ctx mergeVariableValue readGlobal (sGlobalValues a) (sGlobalValues b) + locals <- mergeMaps ctx mergeVariableValue readVariable (sLocalValues a) (sLocalValues b) + prefix <- mergeMaps ctx mergeVariableValue readVariable (sPrefixValues a) (sPrefixValues b) + funcs <- mergeMaps ctx S.union readFunction (sFunctionTargets a) (sFunctionTargets b) + return $ InternalState { + sVersion = -1, + sGlobalValues = globals, + sLocalValues = locals, + sPrefixValues = prefix, + sFunctionTargets = funcs, + sIsReachable = liftM2 (&&) (sIsReachable a) (sIsReachable b) + } + +-- Merge a number of states, or return a default if there are no states +-- (it can't fold from newInternalState because this would be equivalent of adding a new input edge). +mergeStates :: forall s. Ctx s -> InternalState -> [InternalState] -> ST s InternalState +mergeStates ctx def list = + case list of + [] -> return def + (first:rest) -> foldM (mergeState ctx) first rest + +-- Merge two maps, key by key. If both maps have a key, the 'merger' is used. +-- If only one has the key, the 'reader' is used to fetch a second, and the two are merged as above. +mergeMaps :: (Ord k) => forall s. + Ctx s -> + (v -> v -> v) -> + (Ctx s -> k -> ST s v) -> + (VersionedMap k v) -> + (VersionedMap k v) -> + ST s (VersionedMap k v) +mergeMaps ctx merger reader a b = + if vmIsQuickEqual a b + then return a + else do + new <- M.fromDistinctAscList <$> reverse <$> f [] (M.toAscList $ mapStorage a) (M.toAscList $ mapStorage b) + vmFromMap ctx new + where + f l [] [] = return l + f l [] b = f l b [] + f l ((k,v):rest1) [] = do + other <- reader ctx k + f ((k, merger v other):l) rest1 [] + f l l1@((k1, v1):rest1) l2@((k2, v2):rest2) = + case k1 `compare` k2 of + EQ -> + f ((k1, merger v1 v2):l) rest1 rest2 + LT -> do + nv2 <- reader ctx k1 + f ((k1, merger v1 nv2):l) rest1 l2 + GT -> do + nv1 <- reader ctx k2 + f ((k2, merger nv1 v2):l) l1 rest2 + +vmFromMap ctx map = return $ VersionedMap { + mapVersion = -1, + mapStorage = map +} + +-- Give a VersionedMap a version if it does not already have one. +versionMap ctx map = + if mapVersion map >= 0 + then return map + else do + v <- nextVersion ctx + return map { + mapVersion = v + } + +-- Give an InternalState a version if it does not already have one. +versionState ctx state = + if sVersion state >= 0 + then return state + else do + self <- nextVersion ctx + ssGlobalValues <- versionMap ctx $ sGlobalValues state + ssLocalValues <- versionMap ctx $ sLocalValues state + ssFunctionTargets <- versionMap ctx $ sFunctionTargets state + return state { + sVersion = self, + sGlobalValues = ssGlobalValues, + sLocalValues = ssLocalValues, + sFunctionTargets = ssFunctionTargets + } + +-- Like 'not null' but for 2+ elements +is2plus :: [a] -> Bool +is2plus l = case l of + _:_:_ -> True + _ -> False + +-- Use versions to see if two states are trivially identical +stateIsQuickEqual a b = + let + va = sVersion a + vb = sVersion b + in + va >= 0 && vb >= 0 && va == vb + +-- A manual slow path 'Eq' (it's not derived because it's part of the custom Eq instance) +stateIsSlowEqual a b = + check sGlobalValues + && check sLocalValues + && check sPrefixValues + && check sFunctionTargets + && check sIsReachable + where + check f = f a == f b + +-- Check if two VersionedMaps are trivially equal +vmIsQuickEqual :: VersionedMap k v -> VersionedMap k v -> Bool +vmIsQuickEqual a b = + let + va = mapVersion a + vb = mapVersion b + in + va >= 0 && vb >= 0 && va == vb + +-- A new, empty VersionedMap +vmEmpty = VersionedMap { + mapVersion = 0, + mapStorage = M.empty +} + +-- Map.null for VersionedMaps +vmNull :: VersionedMap k v -> Bool +vmNull m = mapVersion m == 0 || (M.null $ mapStorage m) + +-- Map.lookup for VersionedMaps +vmLookup name map = M.lookup name $ mapStorage map + +-- Map.insert for VersionedMaps +vmInsert key val map = VersionedMap { + mapVersion = -1, + mapStorage = M.insert key val $ mapStorage map +} + +-- Overwrite all keys in the first map with values from the second +vmPatch :: (Ord k) => VersionedMap k v -> VersionedMap k v -> VersionedMap k v +vmPatch base diff = + case () of + _ | mapVersion base == 0 -> diff + _ | mapVersion diff == 0 -> base + _ | vmIsQuickEqual base diff -> diff + _ -> VersionedMap { + mapVersion = -1, + mapStorage = M.unionWith (flip const) (mapStorage base) (mapStorage diff) + } + +-- Modify a variable as with x=1. This applies it to the appropriate scope. +writeVariable :: forall s. Ctx s -> String -> VariableValue -> ST s () +writeVariable ctx name val = do + (_, typ) <- readVariableWithScope ctx name + case typ of + GlobalVar -> writeGlobal ctx name val + LocalVar -> writeLocal ctx name val + -- Prefixed variables actually become local variables in the invoked function + PrefixVar -> writeLocal ctx name val + +writeGlobal ctx name val = do + modifySTRef (cOutput ctx) $ insertGlobal name val + +writeLocal ctx name val = do + modifySTRef (cOutput ctx) $ insertLocal name val + +writePrefix ctx name val = do + modifySTRef (cOutput ctx) $ insertPrefix name val + +-- Look up a variable value, and also return its scope +readVariableWithScope :: forall s. Ctx s -> String -> ST s (VariableValue, VariableScope) +readVariableWithScope ctx name = lookupStack get dep def ctx name + where + def = (unknownVariableValue, GlobalVar) + get = getVariableWithScope + dep k v = + case v of + (val, GlobalVar) -> DepGlobalValue k val + (val, LocalVar) -> DepLocalValue k val + (val, PrefixVar) -> DepPrefixValue k val + +getVariableWithScope :: InternalState -> String -> Maybe (VariableValue, VariableScope) +getVariableWithScope s name = + case (vmLookup name $ sPrefixValues s, vmLookup name $ sLocalValues s, vmLookup name $ sGlobalValues s) of + (Just var, _, _) -> return (var, PrefixVar) + (_, Just var, _) -> return (var, LocalVar) + (_, _, Just var) -> return (var, GlobalVar) + _ -> Nothing + +undefineFunction ctx name = + writeFunction ctx name $ FunctionUnknown + +undefineVariable ctx name = + writeVariable ctx name $ emptyVariableValue + +readVariable ctx name = fst <$> readVariableWithScope ctx name + +readGlobal ctx name = lookupStack get dep def ctx name + where + def = unknownVariableValue + get s name = vmLookup name $ sGlobalValues s + dep k v = DepGlobalValue k v + +readFunction ctx name = lookupStack get dep def ctx name + where + def = unknownFunctionValue + get s name = vmLookup name $ sFunctionTargets s + dep k v = DepFunction k v + +writeFunction ctx name val = do + modifySTRef (cOutput ctx) $ insertFunction name $ S.singleton val + +-- Look up each state on the stack until a value is found (or the default is used), +-- then add this value as a StateDependency. +lookupStack :: forall s k v. + -- A function that maybe finds a value from a state + (InternalState -> k -> Maybe v) + -- A function that creates a dependency on what was found + -> (k -> v -> StateDependency) + -- A default value, if the value can't be found anywhere + -> v + -- Context + -> Ctx s + -- The key to look up + -> k + -- Returning the result + -> ST s v +lookupStack get dep def ctx key = do + top <- readSTRef $ cInput ctx + case get top key of + Just v -> return v + Nothing -> f (cStack ctx) + where + f [] = return def + f (s:rest) = do + -- Go up the stack until we find the value, and add + -- a dependency on each state (including where it was found) + res <- fromMaybe (f rest) (return <$> get (stackState s) key) + modifySTRef (dependencies s) $ S.insert $ dep key res + return res + +-- Like lookupStack but without adding dependencies +peekStack get def ctx key = do + top <- readSTRef $ cInput ctx + case get top key of + Just v -> return v + Nothing -> f (cStack ctx) + where + f [] = return def + f (s:rest) = + case get (stackState s) key of + Just v -> return v + Nothing -> f rest + +-- Check if the current context fulfills a StateDependency +fulfillsDependency ctx dep = + case dep of + DepGlobalValue name val -> (== (val, GlobalVar)) <$> peek ctx name + DepLocalValue name val -> (== (val, LocalVar)) <$> peek ctx name + DepPrefixValue name val -> (== (val, PrefixVar)) <$> peek ctx name + DepFunction name val -> (== val) <$> peekFunc ctx name + DepIsRecursive node val -> return $ val == any (\f -> entryPoint f == node) (cStack ctx) + -- _ -> error $ "Unknown dep " ++ show dep + where + peek = peekStack getVariableWithScope (unknownVariableValue, GlobalVar) + peekFunc = peekStack (\state name -> vmLookup name $ sFunctionTargets state) unknownFunctionValue + +-- Check if the current context fulfills all StateDependencies +fulfillsDependencies ctx deps = + f $ S.toList deps + where + f [] = return True + f (dep:rest) = do + res <- fulfillsDependency ctx dep + if res + then f rest + else return False + +-- Create a brand new Ctx given a Control Flow Graph (CFG) +newCtx g = do + c <- newSTRef 1 + input <- newSTRef undefined + output <- newSTRef undefined + node <- newSTRef undefined + cache <- newSTRef M.empty + invocations <- newSTRef M.empty + return $ Ctx { + cCounter = c, + cInput = input, + cOutput = output, + cNode = node, + cCache = cache, + cStack = [], + cInvocations = invocations, + cGraph = g + } + +-- The next incrementing version for VersionedMaps +nextVersion ctx = do + let ctr = cCounter ctx + n <- readSTRef ctr + writeSTRef ctr $! n+1 + return n + +-- Create a new StackEntry +newStackEntry ctx point = do + deps <- newSTRef S.empty + state <- readSTRef $ cOutput ctx + callsite <- readSTRef $ cNode ctx + return $ StackEntry { + entryPoint = point, + callSite = callsite, + dependencies = deps, + stackState = state + } + +-- Call a function with a new stack entry on the stack +withNewStackFrame ctx node f = do + newEntry <- newStackEntry ctx node + newInput <- newSTRef newInternalState + newOutput <- newSTRef newInternalState + newNode <- newSTRef node + let newCtx = ctx { + cInput = newInput, + cOutput = newOutput, + cNode = newNode, + cStack = newEntry : cStack ctx + } + x <- f newCtx + + {- + deps <- readSTRef $ dependencies newEntry + selfcheck <- fulfillsDependencies newCtx deps + unless selfcheck $ error $ pleaseReport $ "Unmet stack dependencies on " ++ show (node, deps) + -} + + return (x, newEntry) + +-- Check if invoking this function would be a recursive loop +-- (i.e. we already have the function on the stack) +wouldBeRecursive ctx node = f (cStack ctx) + where + f [] = return False + f (s:rest) = do + res <- + if entryPoint s == node + then return True + else f rest + modifySTRef (dependencies s) $ S.insert $ DepIsRecursive node res + return res + +-- The main DFA 'transfer' function, applying the effects of a node to the output state +transfer ctx label = + --traceShow ("Transferring", label) $ + case label of + CFStructuralNode -> return () + CFEntryPoint _ -> return () + CFImpliedExit -> return () + CFResolvedExit {} -> return () + + CFExecuteCommand cmd -> transferCommand ctx cmd + CFExecuteSubshell reason entry exit -> transferSubshell ctx reason entry exit + CFApplyEffects effects -> mapM_ (\(IdTagged _ f) -> transferEffect ctx f) effects + + CFUnresolvedExit -> patchOutputM ctx unreachableState + CFUnreachable -> patchOutputM ctx unreachableState + + -- TODO + CFSetBackgroundPid _ -> return () + CFSetExitCode _ -> return () + CFDropPrefixAssignments {} -> + modifySTRef (cOutput ctx) $ \c -> modified c { sPrefixValues = vmEmpty } +-- _ -> error $ "Unknown " ++ show label + + +-- Transfer the effects of a subshell invocation. This is similar to a function call +-- to allow easily discarding the effects (otherwise the InternalState would have +-- to represent subshell depth, while this way it can simply use the function stack). +transferSubshell ctx reason entry exit = do + let cout = cOutput ctx + initial <- readSTRef cout + runCached ctx entry (f entry exit) + -- Clear subshell changes. TODO: track this to warn about modifications. + writeSTRef cout initial + where + f entry exit ctx = do + (states, frame) <- withNewStackFrame ctx entry (flip dataflow $ entry) + let (_, res) = fromMaybe (error $ pleaseReport "Subshell has no exit") $ M.lookup exit states + deps <- readSTRef $ dependencies frame + registerFlowResult ctx entry states deps + return (deps, res) + +-- Transfer the effects of executing a command, i.e. the merged union of all possible function definitions. +transferCommand ctx Nothing = return () +transferCommand ctx (Just name) = do + targets <- readFunction ctx name + --traceShowM ("Transferring ",name,targets) + transferMultiple ctx $ map (flip transferFunctionValue) $ S.toList targets + +-- Transfer a set of function definitions and merge the output states. +transferMultiple ctx funcs = do +-- traceShowM ("Transferring set of ", length funcs) + original <- readSTRef out + branches <- mapM (apply ctx original) funcs + merged <- mergeStates ctx original branches + let patched = patchState original merged + writeSTRef out patched + where + out = cOutput ctx + apply ctx original f = do + writeSTRef out original + f ctx + readSTRef out + +-- Transfer the effects of a single function definition. +transferFunctionValue ctx funcVal = + case funcVal of + FunctionUnknown -> return () + FunctionDefinition name entry exit -> do + isRecursive <- wouldBeRecursive ctx entry + if isRecursive + then return () -- TODO: Find a better strategy for recursion + else runCached ctx entry (f name entry exit) + where + f name entry exit ctx = do + (states, frame) <- withNewStackFrame ctx entry (flip dataflow $ entry) + deps <- readSTRef $ dependencies frame + let res = + case M.lookup exit states of + Just (input, output) -> do + -- Discard local variables. TODO: track&retain variables declared local in previous scopes? + modified output { sLocalValues = vmEmpty } + Nothing -> do + -- e.g. f() { exit; } + unreachableState + registerFlowResult ctx entry states deps + return (deps, res) + + +-- Register/save the result of a dataflow of a function. +-- At the end, all the different values from different flows are merged together. +registerFlowResult ctx entry states deps = do + -- This function is called in the context of a CFExecuteCommand and not its invoked function, + -- so manually add the current node to the stack. + current <- readSTRef $ cNode ctx + let parents = map callSite $ cStack ctx + -- A unique path to this flow context. The specific value doesn't matter, as long as it's + -- unique per invocation of the function. This is required so that 'x=1; f; x=2; f' won't + -- overwrite each other. + let path = entry : current : parents + modifySTRef (cInvocations ctx) $ M.insert path (deps, states) + + +-- Look up a node in the cache and see if the dependencies of any entries are matched. +-- In that case, reuse the previous result instead of doing a new data flow. +runCached :: forall s. Ctx s -> Node -> (Ctx s -> ST s (S.Set StateDependency, InternalState)) -> ST s () +runCached ctx node f = do + cache <- getCache ctx node + case cache of + Just v -> do + -- traceShowM $ ("Running cached", node) + patchOutputM ctx v + Nothing -> do + -- traceShowM $ ("Cache failed", node) + (deps, diff) <- f ctx + modifySTRef (cCache ctx) (M.insertWith (\_ old -> (deps, diff):(take cacheEntries old)) node [(deps,diff)]) + -- traceShowM $ ("Recomputed cache for", node, deps) + patchOutputM ctx diff + +-- Get a cached version whose dependencies are currently fulfilled, if any. +getCache :: forall s. Ctx s -> Node -> ST s (Maybe InternalState) +getCache ctx node = do + cache <- readSTRef $ cCache ctx + -- traceShowM $ ("Cache for", node, "length", length $ M.findWithDefault [] node cache, M.lookup node cache) + f $ M.findWithDefault [] node cache + where + f [] = return Nothing + f ((deps, value):rest) = do + match <- fulfillsDependencies ctx deps + if match + then return $ Just value + else f rest + +-- Transfer a single CFEffect to the output state. +transferEffect ctx effect = + case effect of + CFReadVariable name -> do + void $ readVariable ctx name + CFWriteVariable name value -> do + val <- cfValueToVariableValue ctx value + writeVariable ctx name val + CFWriteGlobal name value -> do + val <- cfValueToVariableValue ctx value + writeGlobal ctx name val + CFWriteLocal name value -> do + val <- cfValueToVariableValue ctx value + writeLocal ctx name val + CFWritePrefix name value -> do + val <- cfValueToVariableValue ctx value + writePrefix ctx name val + CFUndefineVariable name -> undefineVariable ctx name + CFUndefineFunction name -> undefineFunction ctx name + CFUndefine name -> do + -- This should really just unset one or the other + undefineVariable ctx name + undefineFunction ctx name + CFDefineFunction name id entry exit -> + writeFunction ctx name $ FunctionDefinition name entry exit + + -- TODO + CFUndefineNameref name -> undefineVariable ctx name + CFHintArray name -> return () + CFHintDefined name -> return () + CFModifyProps {} -> return () +-- _ -> error $ "Unknown effect " ++ show effect + + + +-- Transfer the CFG's idea of a value into our VariableState +cfValueToVariableValue ctx val = + case val of + CFValueArray -> return unknownVariableValue -- TODO: Track array status + CFValueComputed _ parts -> foldM f emptyVariableValue parts + CFValueInteger -> return unknownIntegerValue + CFValueString -> return unknownVariableValue + CFValueUninitialized -> return emptyVariableValue +-- _ -> error $ "Unknown value: " ++ show val + where + f val part = do + next <- computeValue ctx part + return $ val `appendVariableValue` next + +-- A value can be computed from 0 or more parts, such as x="literal$y$z" +computeValue ctx part = + case part of + CFStringLiteral str -> return $ literalToVariableValue str + CFStringInteger -> return unknownIntegerValue + CFStringUnknown -> return unknownVariableValue + CFStringVariable name -> readVariable ctx name + +-- Append two VariableValues as if with z="$x$y" +appendVariableValue :: VariableValue -> VariableValue -> VariableValue +appendVariableValue a b = + VariableValue { + literalValue = liftM2 (++) (literalValue a) (literalValue b), + spaceStatus = appendSpaceStatus (spaceStatus a) (spaceStatus b) + } + +appendSpaceStatus a b = + case (a,b) of + (SpaceStatusEmpty, _) -> b + (_, SpaceStatusEmpty) -> a + (SpaceStatusClean, SpaceStatusClean) -> a + _ ->SpaceStatusDirty + +unknownIntegerValue = VariableValue { + literalValue = Nothing, + spaceStatus = SpaceStatusClean +} + +literalToVariableValue str = VariableValue { + literalValue = Just str, + spaceStatus = literalToSpaceStatus str +} + +withoutChanges ctx f = do + let inp = cInput ctx + let out = cOutput ctx + prevInput <- readSTRef inp + prevOutput <- readSTRef out + res <- f + writeSTRef inp prevInput + writeSTRef out prevOutput + return res + +-- Get the SpaceStatus for a literal string, i.e. if it needs quoting +literalToSpaceStatus str = + case str of + "" -> SpaceStatusEmpty + _ | all (`notElem` " \t\n*?[") str -> SpaceStatusClean + _ -> SpaceStatusDirty + +type StateMap = M.Map Node (InternalState, InternalState) + +-- Classic, iterative Data Flow Analysis. See Wikipedia for a description of the process. +dataflow :: forall s. Ctx s -> Node -> ST s StateMap +dataflow ctx entry = do + pending <- newSTRef $ S.singleton entry + states <- newSTRef $ M.empty + -- Should probably be done via a stack frame instead + withoutChanges ctx $ + f iterationCount pending states + readSTRef states + where + graph = cGraph ctx + f 0 _ _ = error $ pleaseReport "DFA did not reach fix point" + f n pending states = do + ps <- readSTRef pending + if S.null ps + then return () + else do + let (next, rest) = S.deleteFindMin ps + nexts <- process states next + writeSTRef pending $ foldl (flip S.insert) rest nexts + f (n-1) pending states + + process states node = do + stateMap <- readSTRef states + let inputs = filter (\c -> sIsReachable c /= Just False) $ mapMaybe (\c -> fmap snd $ M.lookup c stateMap) incoming + input <- + case incoming of + [] -> return newInternalState + _ -> + case inputs of + [] -> return unreachableState + (x:rest) -> foldM (mergeState ctx) x rest + writeSTRef (cInput ctx) $ input + writeSTRef (cOutput ctx) $ input + writeSTRef (cNode ctx) $ node + transfer ctx label + newOutput <- readSTRef $ cOutput ctx + result <- + if is2plus outgoing + then + -- Version the state because we split and will probably merge later + versionState ctx newOutput + else return newOutput + writeSTRef states $ M.insert node (input, result) stateMap + case M.lookup node stateMap of + Nothing -> return outgoing + Just (oldInput, oldOutput) -> + if oldOutput == result + then return [] + else return outgoing + where + (incomingL, _, label, outgoingL) = context graph $ node + incoming = map snd $ filter isRegular $ incomingL + outgoing = map snd outgoingL + isRegular = ((== CFEFlow) . fst) + +runRoot ctx entry exit = do + let env = createEnvironmentState + writeSTRef (cInput ctx) $ env + writeSTRef (cOutput ctx) $ env + writeSTRef (cNode ctx) $ entry + (states, frame) <- withNewStackFrame ctx entry $ \c -> dataflow c entry + deps <- readSTRef $ dependencies frame + registerFlowResult ctx entry states deps + -- Return the final state, used to invoke functions that were declared but not invoked + return $ snd $ fromMaybe (error $ pleaseReport "Missing exit state") $ M.lookup exit states + + +analyzeControlFlow :: CFGParameters -> Token -> CFGAnalysis +analyzeControlFlow params t = + let + cfg = buildGraph params t + (entry, exit) = M.findWithDefault (error $ pleaseReport "Missing root") (getId t) (cfIdToNode cfg) + in + runST $ f cfg entry exit + where + f cfg entry exit = do + ctx <- newCtx $ cfGraph cfg + -- Do a dataflow analysis starting on the root node + exitState <- runRoot ctx entry exit + + -- All nodes we've touched + invocations <- readSTRef $ cInvocations ctx + let invokedNodes = M.fromDistinctAscList $ map (\c -> (c, ())) $ S.toList $ M.keysSet $ groupByNode $ M.map snd invocations + + -- Invoke all functions that were declared but not invoked + -- This is so that we still get warnings for dead code + -- (it's probably not actually dead, just used by a script that sources ours) + let declaredFunctions = getFunctionTargets exitState + let uninvoked = M.difference declaredFunctions invokedNodes + analyzeStragglers ctx exitState uninvoked + + -- Now round up all the states from all data flows + -- (FIXME: this excludes functions that were defined in straggling functions) + invocations <- readSTRef $ cInvocations ctx + invokedStates <- flattenByNode ctx $ groupByNode $ M.map addDeps invocations + + -- Fill in the map with unreachable states for anything we didn't get to + let baseStates = M.fromDistinctAscList $ map (\c -> (c, (unreachableState, unreachableState))) $ uncurry enumFromTo $ nodeRange $ cfGraph cfg + let allStates = M.unionWith (flip const) baseStates invokedStates + + -- Convert to external states + let nodeToData = M.map (\(a,b) -> (internalToExternal a, internalToExternal b)) allStates + + return $ nodeToData `deepseq` CFGAnalysis { + graph = cfGraph cfg, + tokenToNode = cfIdToNode cfg, + nodeToData = nodeToData + } + + + -- Include the dependencies in the state of each function, e.g. if it depends on `x=foo` then add that. + addDeps :: (S.Set StateDependency, M.Map Node (InternalState, InternalState)) -> M.Map Node (InternalState, InternalState) + addDeps (deps, m) = let base = depsToState deps in M.map (\(a,b) -> (base `patchState` a, base `patchState` b)) m + + -- Collect all the states that each node has resulted in. + groupByNode :: forall k v. M.Map k (M.Map Node v) -> M.Map Node [v] + groupByNode pathMap = M.fromListWith (++) $ map (\(k,v) -> (k,[v])) $ concatMap M.toList $ M.elems pathMap + + -- Merge all the pre/post states for each node. This would have been a foldM if Map had one. + flattenByNode ctx m = M.fromDistinctAscList <$> (mapM (mergePair ctx) $ M.toList m) + + mergeAllStates ctx pairs = + let + (pres, posts) = unzip pairs + in do + pre <- mergeStates ctx (error $ pleaseReport "Null node states") pres + post <- mergeStates ctx (error $ pleaseReport "Null node states") posts + return (pre, post) + + mergePair ctx (node, list) = do + merged <- mergeAllStates ctx list + return (node, merged) + + -- Get the all the functions defined in an InternalState + getFunctionTargets :: InternalState -> M.Map Node FunctionDefinition + getFunctionTargets state = + let + declaredFuncs = S.unions $ mapStorage $ sFunctionTargets state + getFunc d = + case d of + FunctionDefinition _ entry _ -> Just (entry, d) + _ -> Nothing + funcs = mapMaybe getFunc $ S.toList declaredFuncs + in + M.fromList funcs + + +analyzeStragglers ctx state stragglers = do + mapM_ f $ M.elems stragglers + where + f def@(FunctionDefinition name entry exit) = do + writeSTRef (cInput ctx) state + writeSTRef (cOutput ctx) state + writeSTRef (cNode ctx) entry + transferFunctionValue ctx def + + +return [] +runTests = $quickCheckAll diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index e65dc68..cac06bc 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -30,6 +30,7 @@ import ShellCheck.AnalyzerLib import ShellCheck.Data import ShellCheck.Interface import ShellCheck.Parser +import ShellCheck.Prelude import ShellCheck.Regex import Control.Monad diff --git a/src/ShellCheck/Checks/ControlFlow.hs b/src/ShellCheck/Checks/ControlFlow.hs new file mode 100644 index 0000000..9b7635e --- /dev/null +++ b/src/ShellCheck/Checks/ControlFlow.hs @@ -0,0 +1,101 @@ +{- + Copyright 2022 Vidar Holen + + This file is part of ShellCheck. + https://www.shellcheck.net + + ShellCheck is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + ShellCheck is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{-# LANGUAGE TemplateHaskell #-} + +-- Checks that run on the Control Flow Graph (as opposed to the AST) +-- This is scaffolding for a work in progress. + +module ShellCheck.Checks.ControlFlow (checker, optionalChecks, ShellCheck.Checks.ControlFlow.runTests) where + +import ShellCheck.AST +import ShellCheck.ASTLib +import ShellCheck.CFG hiding (cfgAnalysis) +import ShellCheck.CFGAnalysis +import ShellCheck.AnalyzerLib +import ShellCheck.Data +import ShellCheck.Interface + +import Control.Monad +import Control.Monad.Reader +import Data.Graph.Inductive.Graph +import qualified Data.Map as M +import qualified Data.Set as S +import Data.List +import Data.Maybe + +import Test.QuickCheck.All (forAllProperties) +import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess) + + +optionalChecks :: [CheckDescription] +optionalChecks = [] + +-- A check that runs on the entire graph +type ControlFlowCheck = Analysis +-- A check invoked once per node, with its (pre,post) data +type ControlFlowNodeCheck = LNode CFNode -> (ProgramState, ProgramState) -> Analysis +-- A check invoked once per effect, with its node's (pre,post) data +type ControlFlowEffectCheck = IdTagged CFEffect -> Node -> (ProgramState, ProgramState) -> Analysis + + +checker :: AnalysisSpec -> Parameters -> Checker +checker spec params = Checker { + perScript = const $ sequence_ controlFlowChecks, + perToken = const $ return () +} + +controlFlowChecks :: [ControlFlowCheck] +controlFlowChecks = [ + runNodeChecks controlFlowNodeChecks + ] + +controlFlowNodeChecks :: [ControlFlowNodeCheck] +controlFlowNodeChecks = [ + runEffectChecks controlFlowEffectChecks + ] + +controlFlowEffectChecks :: [ControlFlowEffectCheck] +controlFlowEffectChecks = [ + ] + +runNodeChecks :: [ControlFlowNodeCheck] -> ControlFlowCheck +runNodeChecks perNode = do + cfg <- asks cfgAnalysis + runOnAll cfg + where + getData datas n@(node, label) = do + (pre, post) <- M.lookup node datas + return (n, (pre, post)) + + runOn :: (LNode CFNode, (ProgramState, ProgramState)) -> Analysis + runOn (node, prepost) = mapM_ (\c -> c node prepost) perNode + runOnAll cfg = mapM_ runOn $ mapMaybe (getData $ nodeToData cfg) $ labNodes (graph cfg) + +runEffectChecks :: [ControlFlowEffectCheck] -> ControlFlowNodeCheck +runEffectChecks list = checkNode + where + checkNode (node, label) prepost = + case label of + CFApplyEffects effects -> mapM_ (\effect -> mapM_ (\c -> c effect node prepost) list) effects + _ -> return () + + +return [] +runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 22a6a5f..9ad17f5 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -25,6 +25,7 @@ import ShellCheck.AST import ShellCheck.ASTLib import ShellCheck.AnalyzerLib import ShellCheck.Interface +import ShellCheck.Prelude import ShellCheck.Regex import Control.Monad diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index e22b424..fb82ca8 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -2,9 +2,27 @@ module ShellCheck.Data where import ShellCheck.Interface import Data.Version (showVersion) -import Paths_ShellCheck (version) -shellcheckVersion = showVersion version -- VERSIONSTRING + +{- +If you are here because you saw an error about Paths_ShellCheck in this file, +simply comment out the import below and define the version as a constant string. + +Instead of: + + import Paths_ShellCheck (version) + shellcheckVersion = showVersion version + +Use: + + -- import Paths_ShellCheck (version) + shellcheckVersion = "kludge" + +-} + +import Paths_ShellCheck (version) +shellcheckVersion = showVersion version -- VERSIONSTRING + internalVariables = [ -- Generic @@ -43,9 +61,12 @@ internalVariables = [ "flags_error", "flags_return" ] -specialVariablesWithoutSpaces = [ - "$", "-", "?", "!", "#" +specialIntegerVariables = [ + "$", "?", "!", "#" ] + +specialVariablesWithoutSpaces = "-" : specialIntegerVariables + variablesWithoutSpaces = specialVariablesWithoutSpaces ++ [ "BASHPID", "BASH_ARGC", "BASH_LINENO", "BASH_SUBSHELL", "EUID", "LINENO", "OPTIND", "PPID", "RANDOM", "SECONDS", "SHELLOPTS", "SHLVL", "UID", diff --git a/src/ShellCheck/Debug.hs b/src/ShellCheck/Debug.hs new file mode 100644 index 0000000..c991308 --- /dev/null +++ b/src/ShellCheck/Debug.hs @@ -0,0 +1,313 @@ +{- + +This file contains useful functions for debugging and developing ShellCheck. + +To invoke them interactively, run: + + cabal repl + +At the ghci prompt, enter: + + :load ShellCheck.Debug + +You can now invoke the functions. Here are some examples: + + shellcheckString "echo $1" + stringToAst "(( x+1 ))" + stringToCfg "if foo; then bar; else baz; fi" + writeFile "/tmp/test.dot" $ stringToCfgViz "while foo; do bar; done" + +The latter file can be rendered to png with GraphViz: + + dot -Tpng /tmp/test.dot > /tmp/test.png + +To run all unit tests in a module: + + ShellCheck.Parser.runTests + ShellCheck.Analytics.runTests + +To run a specific test: + + :load ShellCheck.Analytics + prop_checkUuoc3 + +If you make code changes, reload in seconds at any time with: + + :r + +=========================================================================== + +Crash course in printf debugging in Haskell: + + import Debug.Trace + + greet 0 = return () + -- Print when a function is invoked + greet n | trace ("calling greet " ++ show n) False = undefined + greet n = do + putStrLn "Enter name" + name <- getLine + -- Print at some point in any monadic function + traceM $ "user entered " ++ name + putStrLn $ "Hello " ++ name + -- Print a value before passing it on + greet $ traceShowId (n - 1) + + +=========================================================================== + +If you want to invoke `ghci` directly, such as on `shellcheck.hs`, to +debug all of ShellCheck including I/O, you may see an error like this: + + src/ShellCheck/Data.hs:5:1: error: + Could not load module ‘Paths_ShellCheck’ + it is a hidden module in the package ‘ShellCheck-0.8.0’ + +This can easily be circumvented by running `./setgitversion` or manually +editing src/ShellCheck/Data.hs to replace the auto-deduced version number +with a constant string as indicated. + +Afterwards, you can run the ShellCheck tool, as if from the shell, with: + + $ ghci shellcheck.hs + ghci> runMain ["-x", "file.sh"] + +-} + +module ShellCheck.Debug () where + +import ShellCheck.Analyzer +import ShellCheck.AST +import ShellCheck.CFG +import ShellCheck.Checker +import ShellCheck.CFGAnalysis as CF +import ShellCheck.Interface +import ShellCheck.Parser +import ShellCheck.Prelude + +import Control.Monad +import Control.Monad.Identity +import Control.Monad.RWS +import Control.Monad.Writer +import Data.Graph.Inductive.Graph as G +import Data.List +import Data.Maybe +import qualified Data.Map as M +import qualified Data.Set as S + + +-- Run all of ShellCheck (minus output formatters) +shellcheckString :: String -> CheckResult +shellcheckString scriptString = + runIdentity $ checkScript dummySystemInterface checkSpec + where + checkSpec :: CheckSpec + checkSpec = emptyCheckSpec { + csScript = scriptString + } + +dummySystemInterface :: SystemInterface Identity +dummySystemInterface = mockedSystemInterface [ + -- A tiny, fake filesystem for sourced files + ("lib/mylib1.sh", "foo=$(cat $1 | wc -l)"), + ("lib/mylib2.sh", "bar=42") + ] + +-- Parameters used when generating Control Flow Graphs +cfgParams :: CFGParameters +cfgParams = CFGParameters { + cfLastpipe = False, + cfPipefail = False +} + +-- An example script to play with +exampleScript :: String +exampleScript = unlines [ + "#!/bin/sh", + "count=0", + "for file in *", + "do", + " (( count++ ))", + "done", + "echo $count" + ] + +-- Parse the script string into ShellCheck's ParseResult +parseScriptString :: String -> ParseResult +parseScriptString scriptString = + runIdentity $ parseScript dummySystemInterface parseSpec + where + parseSpec :: ParseSpec + parseSpec = newParseSpec { + psFilename = "myscript", + psScript = scriptString + } + + +-- Parse the script string into an Abstract Syntax Tree +stringToAst :: String -> Token +stringToAst scriptString = + case maybeRoot of + Just root -> root + Nothing -> error $ "Script failed to parse: " ++ show parserWarnings + where + parseResult :: ParseResult + parseResult = parseScriptString scriptString + + maybeRoot :: Maybe Token + maybeRoot = prRoot parseResult + + parserWarnings :: [PositionedComment] + parserWarnings = prComments parseResult + + +astToCfgResult :: Token -> CFGResult +astToCfgResult = buildGraph cfgParams + +astToDfa :: Token -> CFGAnalysis +astToDfa = analyzeControlFlow cfgParams + +astToCfg :: Token -> CFGraph +astToCfg = cfGraph . astToCfgResult + +stringToCfg :: String -> CFGraph +stringToCfg = astToCfg . stringToAst + +stringToDfa :: String -> CFGAnalysis +stringToDfa = astToDfa . stringToAst + +cfgToGraphViz :: CFGraph -> String +cfgToGraphViz = cfgToGraphVizWith show + +stringToCfgViz :: String -> String +stringToCfgViz = cfgToGraphViz . stringToCfg + +stringToDfaViz :: String -> String +stringToDfaViz = dfaToGraphViz . stringToDfa + +-- Dump a Control Flow Graph as GraphViz with extended information +stringToDetailedCfgViz :: String -> String +stringToDetailedCfgViz scriptString = cfgToGraphVizWith nodeLabel graph + where + ast :: Token + ast = stringToAst scriptString + + cfgResult :: CFGResult + cfgResult = astToCfgResult ast + + graph :: CFGraph + graph = cfGraph cfgResult + + idToToken :: M.Map Id Token + idToToken = M.fromList $ execWriter $ doAnalysis (\c -> tell [(getId c, c)]) ast + + idToNode :: M.Map Id (Node, Node) + idToNode = cfIdToNode cfgResult + + nodeToStartIds :: M.Map Node (S.Set Id) + nodeToStartIds = + M.fromListWith S.union $ + map (\(id, (start, _)) -> (start, S.singleton id)) $ + M.toList idToNode + + nodeToEndIds :: M.Map Node (S.Set Id) + nodeToEndIds = + M.fromListWith S.union $ + map (\(id, (_, end)) -> (end, S.singleton id)) $ + M.toList idToNode + + formatId :: Id -> String + formatId id = fromMaybe ("Unknown " ++ show id) $ do + (OuterToken _ token) <- M.lookup id idToToken + firstWord <- words (show token) !!! 0 + -- Strip off "Inner_" + (_ : tokenName) <- return $ dropWhile (/= '_') firstWord + return $ tokenName ++ " " ++ show id + + formatGroup :: S.Set Id -> String + formatGroup set = intercalate ", " $ map formatId $ S.toList set + + nodeLabel (node, label) = unlines [ + show node ++ ". " ++ show label, + "Begin: " ++ formatGroup (M.findWithDefault S.empty node nodeToStartIds), + "End: " ++ formatGroup (M.findWithDefault S.empty node nodeToEndIds) + ] + + +-- Dump a Control Flow Graph with Data Flow Analysis as GraphViz +dfaToGraphViz :: CF.CFGAnalysis -> String +dfaToGraphViz analysis = cfgToGraphVizWith label $ CF.graph analysis + where + label (node, label) = + let + desc = show node ++ ". " ++ show label + in + fromMaybe ("No DFA available\n\n" ++ desc) $ do + (pre, post) <- M.lookup node $ CF.nodeToData analysis + return $ unlines [ + "Precondition: " ++ show pre, + "", + desc, + "", + "Postcondition: " ++ show post + ] + + +-- Dump an Control Flow Graph to GraphViz with a given node formatter +cfgToGraphVizWith :: (LNode CFNode -> String) -> CFGraph -> String +cfgToGraphVizWith nodeLabel graph = concat [ + "digraph {\n", + concatMap dumpNode (labNodes graph), + concatMap dumpLink (labEdges graph), + tagVizEntries graph, + "}\n" + ] + where + dumpNode l@(node, label) = show node ++ " [label=" ++ quoteViz (nodeLabel l) ++ "]\n" + dumpLink (from, to, typ) = show from ++ " -> " ++ show to ++ " [style=" ++ quoteViz (edgeStyle typ) ++ "]\n" + edgeStyle CFEFlow = "solid" + edgeStyle CFEExit = "bold" + edgeStyle CFEFalseFlow = "dotted" + +quoteViz str = "\"" ++ escapeViz str ++ "\"" +escapeViz [] = [] +escapeViz (c:rest) = + case c of + '\"' -> '\\' : '\"' : escapeViz rest + '\n' -> '\\' : 'l' : escapeViz rest + '\\' -> '\\' : '\\' : escapeViz rest + _ -> c : escapeViz rest + + +-- Dump an Abstract Syntax Tree (or branch thereof) to GraphViz format +astToGraphViz :: Token -> String +astToGraphViz token = concat [ + "digraph {\n", + formatTree token, + "}\n" + ] + where + formatTree :: Token -> String + formatTree t = snd $ execRWS (doStackAnalysis push pop t) () [] + + push :: Token -> RWS () String [Int] () + push (OuterToken (Id n) inner) = do + stack <- get + put (n : stack) + case stack of + [] -> return () + (top:_) -> tell $ show top ++ " -> " ++ show n ++ "\n" + tell $ show n ++ " [label=" ++ quoteViz (show n ++ ": " ++ take 32 (show inner)) ++ "]\n" + + pop :: Token -> RWS () String [Int] () + pop _ = modify tail + + +-- For each entry point, set the rank so that they'll align in the graph +tagVizEntries :: CFGraph -> String +tagVizEntries graph = "{ rank=same " ++ rank ++ " }" + where + entries = mapMaybe find $ labNodes graph + find (node, CFEntryPoint name) = return (node, name) + find _ = Nothing + rank = unwords $ map (\(c, _) -> show c) entries diff --git a/src/ShellCheck/Fixer.hs b/src/ShellCheck/Fixer.hs index 1409b24..2376842 100644 --- a/src/ShellCheck/Fixer.hs +++ b/src/ShellCheck/Fixer.hs @@ -22,6 +22,7 @@ module ShellCheck.Fixer (applyFix, removeTabStops, mapPositions, Ranged(..), runTests) where import ShellCheck.Interface +import ShellCheck.Prelude import Control.Monad.State import Data.Array import Data.List @@ -228,7 +229,7 @@ applyReplacement2 rep string = do let (l1, l2) = tmap posLine originalPos in when (l1 /= 1 || l2 /= 1) $ - error "ShellCheck internal error, please report: bad cross-line fix" + error $ pleaseReport "bad cross-line fix" let replacer = repString rep let shift = (length replacer) - (oldEnd - oldStart) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 3958406..9f9241c 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -27,6 +27,7 @@ import ShellCheck.AST import ShellCheck.ASTLib hiding (runTests) import ShellCheck.Data import ShellCheck.Interface +import ShellCheck.Prelude import Control.Applicative ((<*), (*>)) import Control.Monad @@ -210,7 +211,7 @@ getNextIdSpanningTokenList list = -- Get the span covered by an id getSpanForId :: Monad m => Id -> SCParser m (SourcePos, SourcePos) getSpanForId id = - Map.findWithDefault (error "Internal error: no position for id. Please report!") id <$> + Map.findWithDefault (error $ pleaseReport "no parser span for id") id <$> getMap -- Create a new id with the same span as an existing one @@ -1918,7 +1919,7 @@ readPendingHereDocs = do -- The end token is just a prefix skipLine | hasTrailer -> - error "ShellCheck bug, please report (here doc trailer)." + error $ pleaseReport "unexpected heredoc trailer" -- The following cases assume no trailing text: | dashed == Undashed && (not $ null leadingSpace) -> do diff --git a/src/ShellCheck/Prelude.hs b/src/ShellCheck/Prelude.hs new file mode 100644 index 0000000..7e9011b --- /dev/null +++ b/src/ShellCheck/Prelude.hs @@ -0,0 +1,48 @@ +{- + Copyright 2022 Vidar Holen + + This file is part of ShellCheck. + https://www.shellcheck.net + + ShellCheck is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + ShellCheck is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} + +-- Generic basic utility functions +module ShellCheck.Prelude where + +-- Get element 0 or a default. Like `head` but safe. +headOrDefault _ (a:_) = a +headOrDefault def _ = def + +-- Get the last element or a default. Like `last` but safe. +lastOrDefault def [] = def +lastOrDefault _ list = last list + +--- Get element n of a list, or Nothing. Like `!!` but safe. +(!!!) list i = + case drop i list of + [] -> Nothing + (r:_) -> Just r + + +-- Like mconcat but for Semigroups +sconcat1 :: (Semigroup t) => [t] -> t +sconcat1 [x] = x +sconcat1 (x:xs) = x <> sconcat1 xs + +sconcatOrDefault def [] = def +sconcatOrDefault _ list = sconcat1 list + +-- For more actionable "impossible" errors +pleaseReport str = "ShellCheck internal error, please report: " ++ str diff --git a/test/shellcheck.hs b/test/shellcheck.hs index e463403..1a272af 100644 --- a/test/shellcheck.hs +++ b/test/shellcheck.hs @@ -5,8 +5,11 @@ import System.Exit import qualified ShellCheck.Analytics import qualified ShellCheck.AnalyzerLib import qualified ShellCheck.ASTLib +import qualified ShellCheck.CFG +import qualified ShellCheck.CFGAnalysis import qualified ShellCheck.Checker import qualified ShellCheck.Checks.Commands +import qualified ShellCheck.Checks.ControlFlow import qualified ShellCheck.Checks.Custom import qualified ShellCheck.Checks.ShellSupport import qualified ShellCheck.Fixer @@ -19,8 +22,11 @@ main = do ShellCheck.Analytics.runTests ,ShellCheck.AnalyzerLib.runTests ,ShellCheck.ASTLib.runTests + ,ShellCheck.CFG.runTests + ,ShellCheck.CFGAnalysis.runTests ,ShellCheck.Checker.runTests ,ShellCheck.Checks.Commands.runTests + ,ShellCheck.Checks.ControlFlow.runTests ,ShellCheck.Checks.Custom.runTests ,ShellCheck.Checks.ShellSupport.runTests ,ShellCheck.Fixer.runTests From 642ad8612597b28af4026bde289985583fddb69d Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 19 Jul 2022 14:33:00 -0700 Subject: [PATCH 024/244] Add SC2317 warning about unreachable commands --- CHANGELOG.md | 1 + src/ShellCheck/Analytics.hs | 32 ++++++++++++++++++++++++-------- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4763ddd..6e1dba3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,7 @@ ## Git ### Added - SC2316: Warn about 'local readonly foo' and similar (thanks, patrickxia!) +- SC2317: Warn about unreachable commands ### Fixed diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index bf5d179..e6c0160 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -202,6 +202,7 @@ nodeChecks = [ ,checkCommandWithTrailingSymbol ,checkUnquotedParameterExpansionPattern ,checkBatsTestDoesNotUseNegation + ,checkCommandIsUnreachable ] optionalChecks = map fst optionalTreeChecks @@ -4129,13 +4130,6 @@ checkAliasUsedInSameParsingUnit params root = checkUnit :: [Token] -> Writer [TokenComment] () checkUnit unit = evalStateT (mapM_ (doAnalysis findCommands) unit) (Map.empty) - isSourced t = - let - f (T_SourceCommand {}) = True - f _ = False - in - any f $ getPath (parentMap params) t - findCommands :: Token -> StateT (Map.Map String Token) (Writer [TokenComment]) () findCommands t = case t of T_SimpleCommand _ _ (cmd:args) -> @@ -4146,7 +4140,7 @@ checkAliasUsedInSameParsingUnit params root = cmd <- gets (Map.lookup name) case cmd of Just alias -> - unless (isSourced t || shouldIgnoreCode params 2262 alias) $ do + unless (isSourced params t || shouldIgnoreCode params 2262 alias) $ do warn (getId alias) 2262 "This alias can't be defined and used in the same parsing unit. Use a function instead." info (getId t) 2263 "Since they're in the same parsing unit, this command will not refer to the previously mentioned alias." _ -> return () @@ -4157,6 +4151,14 @@ checkAliasUsedInSameParsingUnit params root = when (isVariableName name && not (null value)) $ modify (Map.insertWith (\new old -> old) name arg) +isSourced params t = + let + f (T_SourceCommand {}) = True + f _ = False + in + any f $ getPath (parentMap params) t + + -- Like groupBy, but compares pairs of adjacent elements, rather than against the first of the span prop_groupByLink1 = groupByLink (\a b -> a+1 == b) [1,2,3,2,3,7,8,9] == [[1,2,3], [2,3], [7,8,9]] prop_groupByLink2 = groupByLink (==) ([] :: [()]) == [] @@ -4910,5 +4912,19 @@ checkBatsTestDoesNotUseNegation params t = x:rest -> isLastOf t rest [] -> False + +prop_checkCommandIsUnreachable1 = verify checkCommandIsUnreachable "foo; bar; exit; baz" +prop_checkCommandIsUnreachable2 = verify checkCommandIsUnreachable "die() { exit; }; foo; bar; die; baz" +prop_checkCommandIsUnreachable3 = verifyNot checkCommandIsUnreachable "foo; bar || exit; baz" +checkCommandIsUnreachable params t = + case t of + T_Pipeline {} -> sequence_ $ do + state <- CF.getIncomingState (cfgAnalysis params) id + guard . not $ CF.stateIsReachable state + guard . not $ isSourced params t + return $ info id 2317 "Command appears to be unreachable. Check usage (or ignore if invoked indirectly)." + _ -> return () + where id = getId t + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) From da4885a71d08c76c6ff5d01012d135d54fa68f4e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 19 Jul 2022 14:33:00 -0700 Subject: [PATCH 025/244] Use DFA for SC2086 --- CHANGELOG.md | 1 + src/ShellCheck/Analytics.hs | 272 ++++++++++++++---------------------- 2 files changed, 104 insertions(+), 169 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6e1dba3..66d5369 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,7 @@ - SC2317: Warn about unreachable commands ### Fixed +- SC2086: Now uses DFA to make more accurate predictions about values ### Changed - ShellCheck now has a Data Flow Analysis engine to make smarter decisions diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e6c0160..0062879 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -54,7 +54,6 @@ treeChecks :: [Parameters -> Token -> [TokenComment]] treeChecks = [ nodeChecksToTreeCheck nodeChecks ,subshellAssignmentCheck - ,checkSpacefulness ,checkQuotesInLiterals ,checkShebangParameters ,checkFunctionsUsedExternally @@ -203,6 +202,7 @@ nodeChecks = [ ,checkUnquotedParameterExpansionPattern ,checkBatsTestDoesNotUseNegation ,checkCommandIsUnreachable + ,checkSpacefulnessCfg ] optionalChecks = map fst optionalTreeChecks @@ -221,7 +221,7 @@ optionalTreeChecks = [ cdDescription = "Suggest quoting variables without metacharacters", cdPositive = "var=hello; echo $var", cdNegative = "var=hello; echo \"$var\"" - }, checkVerboseSpacefulness) + }, nodeChecksToTreeCheck [checkVerboseSpacefulnessCfg]) ,(newCheckDescription { cdName = "avoid-nullary-conditions", @@ -2009,109 +2009,6 @@ doVariableFlowAnalysis readFunc writeFunc empty flow = evalState ( writeFunc base token name values doFlow _ = return [] ----- Check whether variables could have spaces/globs -prop_checkSpacefulness1 = verifyTree checkSpacefulness "a='cow moo'; echo $a" -prop_checkSpacefulness2 = verifyNotTree checkSpacefulness "a='cow moo'; [[ $a ]]" -prop_checkSpacefulness3 = verifyNotTree checkSpacefulness "a='cow*.mp3'; echo \"$a\"" -prop_checkSpacefulness4 = verifyTree checkSpacefulness "for f in *.mp3; do echo $f; done" -prop_checkSpacefulness4a= verifyNotTree checkSpacefulness "foo=3; foo=$(echo $foo)" -prop_checkSpacefulness5 = verifyTree checkSpacefulness "a='*'; b=$a; c=lol${b//foo/bar}; echo $c" -prop_checkSpacefulness6 = verifyTree checkSpacefulness "a=foo$(lol); echo $a" -prop_checkSpacefulness7 = verifyTree checkSpacefulness "a=foo\\ bar; rm $a" -prop_checkSpacefulness8 = verifyNotTree checkSpacefulness "a=foo\\ bar; a=foo; rm $a" -prop_checkSpacefulness10= verifyTree checkSpacefulness "rm $1" -prop_checkSpacefulness11= verifyTree checkSpacefulness "rm ${10//foo/bar}" -prop_checkSpacefulness12= verifyNotTree checkSpacefulness "(( $1 + 3 ))" -prop_checkSpacefulness13= verifyNotTree checkSpacefulness "if [[ $2 -gt 14 ]]; then true; fi" -prop_checkSpacefulness14= verifyNotTree checkSpacefulness "foo=$3 env" -prop_checkSpacefulness15= verifyNotTree checkSpacefulness "local foo=$1" -prop_checkSpacefulness16= verifyNotTree checkSpacefulness "declare foo=$1" -prop_checkSpacefulness17= verifyTree checkSpacefulness "echo foo=$1" -prop_checkSpacefulness18= verifyNotTree checkSpacefulness "$1 --flags" -prop_checkSpacefulness19= verifyTree checkSpacefulness "echo $PWD" -prop_checkSpacefulness20= verifyNotTree checkSpacefulness "n+='foo bar'" -prop_checkSpacefulness21= verifyNotTree checkSpacefulness "select foo in $bar; do true; done" -prop_checkSpacefulness22= verifyNotTree checkSpacefulness "echo $\"$1\"" -prop_checkSpacefulness23= verifyNotTree checkSpacefulness "a=(1); echo ${a[@]}" -prop_checkSpacefulness24= verifyTree checkSpacefulness "a='a b'; cat <<< $a" -prop_checkSpacefulness25= verifyTree checkSpacefulness "a='s/[0-9]//g'; sed $a" -prop_checkSpacefulness26= verifyTree checkSpacefulness "a='foo bar'; echo {1,2,$a}" -prop_checkSpacefulness27= verifyNotTree checkSpacefulness "echo ${a:+'foo'}" -prop_checkSpacefulness28= verifyNotTree checkSpacefulness "exec {n}>&1; echo $n" -prop_checkSpacefulness29= verifyNotTree checkSpacefulness "n=$(stuff); exec {n}>&-;" -prop_checkSpacefulness30= verifyTree checkSpacefulness "file='foo bar'; echo foo > $file;" -prop_checkSpacefulness31= verifyNotTree checkSpacefulness "echo \"`echo \\\"$1\\\"`\"" -prop_checkSpacefulness32= verifyNotTree checkSpacefulness "var=$1; [ -v var ]" -prop_checkSpacefulness33= verifyTree checkSpacefulness "for file; do echo $file; done" -prop_checkSpacefulness34= verifyTree checkSpacefulness "declare foo$n=$1" -prop_checkSpacefulness35= verifyNotTree checkSpacefulness "echo ${1+\"$1\"}" -prop_checkSpacefulness36= verifyNotTree checkSpacefulness "arg=$#; echo $arg" -prop_checkSpacefulness37= verifyNotTree checkSpacefulness "@test 'status' {\n [ $status -eq 0 ]\n}" -prop_checkSpacefulness37v = verifyTree checkVerboseSpacefulness "@test 'status' {\n [ $status -eq 0 ]\n}" -prop_checkSpacefulness38= verifyTree checkSpacefulness "a=; echo $a" -prop_checkSpacefulness39= verifyNotTree checkSpacefulness "a=''\"\"''; b=x$a; echo $b" -prop_checkSpacefulness40= verifyNotTree checkSpacefulness "a=$((x+1)); echo $a" -prop_checkSpacefulness41= verifyNotTree checkSpacefulness "exec $1 --flags" -prop_checkSpacefulness42= verifyNotTree checkSpacefulness "run $1 --flags" -prop_checkSpacefulness43= verifyNotTree checkSpacefulness "$foo=42" -prop_checkSpacefulness44= verifyTree checkSpacefulness "#!/bin/sh\nexport var=$value" -prop_checkSpacefulness45= verifyNotTree checkSpacefulness "wait -zzx -p foo; echo $foo" -prop_checkSpacefulness46= verifyNotTree checkSpacefulness "x=0; (( x += 1 )); echo $x" -prop_checkSpacefulness47= verifyNotTree checkSpacefulness "x=0; (( x-- )); echo $x" -prop_checkSpacefulness48= verifyNotTree checkSpacefulness "x=0; (( ++x )); echo $x" - -data SpaceStatus = SpaceSome | SpaceNone | SpaceEmpty deriving (Eq) -instance Semigroup SpaceStatus where - SpaceNone <> SpaceNone = SpaceNone - SpaceSome <> _ = SpaceSome - _ <> SpaceSome = SpaceSome - SpaceEmpty <> x = x - x <> SpaceEmpty = x -instance Monoid SpaceStatus where - mempty = SpaceEmpty - mappend = (<>) - --- This is slightly awkward because we want to support structured --- optional checks based on nearly the same logic -checkSpacefulness params = checkSpacefulness' onFind params - where - emit x = tell [x] - onFind spaces token _ = - when (spaces /= SpaceNone) $ - if isDefaultAssignment (parentMap params) token - then - emit $ makeComment InfoC (getId token) 2223 - "This default assignment may cause DoS due to globbing. Quote it." - else - unless (quotesMayConflictWithSC2281 params token) $ - emit $ makeCommentWithFix InfoC (getId token) 2086 - "Double quote to prevent globbing and word splitting." - (addDoubleQuotesAround params token) - - isDefaultAssignment parents token = - let modifier = getBracedModifier $ bracedString token in - any (`isPrefixOf` modifier) ["=", ":="] - && isParamTo parents ":" token - - -- Given a T_DollarBraced, return a simplified version of the string contents. - bracedString (T_DollarBraced _ _ l) = concat $ oversimplify l - bracedString _ = error "Internal shellcheck error, please report! (bracedString on non-variable)" - -prop_checkSpacefulness4v= verifyTree checkVerboseSpacefulness "foo=3; foo=$(echo $foo)" -prop_checkSpacefulness8v= verifyTree checkVerboseSpacefulness "a=foo\\ bar; a=foo; rm $a" -prop_checkSpacefulness28v = verifyTree checkVerboseSpacefulness "exec {n}>&1; echo $n" -prop_checkSpacefulness36v = verifyTree checkVerboseSpacefulness "arg=$#; echo $arg" -prop_checkSpacefulness44v = verifyNotTree checkVerboseSpacefulness "foo=3; $foo=4" -checkVerboseSpacefulness params = checkSpacefulness' onFind params - where - onFind spaces token name = - when (spaces == SpaceNone - && name `notElem` specialVariablesWithoutSpaces - && not (quotesMayConflictWithSC2281 params token)) $ - tell [makeCommentWithFix StyleC (getId token) 2248 - "Prefer double quoting even when variables don't contain special characters." - (addDoubleQuotesAround params token)] - -- Don't suggest quotes if this will instead be autocorrected -- from $foo=bar to foo=bar. This is not pretty but ok. quotesMayConflictWithSC2281 params t = @@ -2121,74 +2018,111 @@ quotesMayConflictWithSC2281 params t = _ -> False addDoubleQuotesAround params token = (surroundWith (getId token) params "\"") -checkSpacefulness' - :: (SpaceStatus -> Token -> String -> Writer [TokenComment] ()) -> - Parameters -> Token -> [TokenComment] -checkSpacefulness' onFind params t = - doVariableFlowAnalysis readF writeF (Map.fromList defaults) (variableFlow params) + +prop_checkSpacefulnessCfg1 = verify checkSpacefulnessCfg "a='cow moo'; echo $a" +prop_checkSpacefulnessCfg2 = verifyNot checkSpacefulnessCfg "a='cow moo'; [[ $a ]]" +prop_checkSpacefulnessCfg3 = verifyNot checkSpacefulnessCfg "a='cow*.mp3'; echo \"$a\"" +prop_checkSpacefulnessCfg4 = verify checkSpacefulnessCfg "for f in *.mp3; do echo $f; done" +prop_checkSpacefulnessCfg4a= verifyNot checkSpacefulnessCfg "foo=3; foo=$(echo $foo)" +prop_checkSpacefulnessCfg5 = verify checkSpacefulnessCfg "a='*'; b=$a; c=lol${b//foo/bar}; echo $c" +prop_checkSpacefulnessCfg6 = verify checkSpacefulnessCfg "a=foo$(lol); echo $a" +prop_checkSpacefulnessCfg7 = verify checkSpacefulnessCfg "a=foo\\ bar; rm $a" +prop_checkSpacefulnessCfg8 = verifyNot checkSpacefulnessCfg "a=foo\\ bar; a=foo; rm $a" +prop_checkSpacefulnessCfg10= verify checkSpacefulnessCfg "rm $1" +prop_checkSpacefulnessCfg11= verify checkSpacefulnessCfg "rm ${10//foo/bar}" +prop_checkSpacefulnessCfg12= verifyNot checkSpacefulnessCfg "(( $1 + 3 ))" +prop_checkSpacefulnessCfg13= verifyNot checkSpacefulnessCfg "if [[ $2 -gt 14 ]]; then true; fi" +prop_checkSpacefulnessCfg14= verifyNot checkSpacefulnessCfg "foo=$3 env" +prop_checkSpacefulnessCfg15= verifyNot checkSpacefulnessCfg "local foo=$1" +prop_checkSpacefulnessCfg16= verifyNot checkSpacefulnessCfg "declare foo=$1" +prop_checkSpacefulnessCfg17= verify checkSpacefulnessCfg "echo foo=$1" +prop_checkSpacefulnessCfg18= verifyNot checkSpacefulnessCfg "$1 --flags" +prop_checkSpacefulnessCfg19= verify checkSpacefulnessCfg "echo $PWD" +prop_checkSpacefulnessCfg20= verifyNot checkSpacefulnessCfg "n+='foo bar'" +prop_checkSpacefulnessCfg21= verifyNot checkSpacefulnessCfg "select foo in $bar; do true; done" +prop_checkSpacefulnessCfg22= verifyNot checkSpacefulnessCfg "echo $\"$1\"" +prop_checkSpacefulnessCfg23= verifyNot checkSpacefulnessCfg "a=(1); echo ${a[@]}" +prop_checkSpacefulnessCfg24= verify checkSpacefulnessCfg "a='a b'; cat <<< $a" +prop_checkSpacefulnessCfg25= verify checkSpacefulnessCfg "a='s/[0-9]//g'; sed $a" +prop_checkSpacefulnessCfg26= verify checkSpacefulnessCfg "a='foo bar'; echo {1,2,$a}" +prop_checkSpacefulnessCfg27= verifyNot checkSpacefulnessCfg "echo ${a:+'foo'}" +prop_checkSpacefulnessCfg28= verifyNot checkSpacefulnessCfg "exec {n}>&1; echo $n" +prop_checkSpacefulnessCfg29= verifyNot checkSpacefulnessCfg "n=$(stuff); exec {n}>&-;" +prop_checkSpacefulnessCfg30= verify checkSpacefulnessCfg "file='foo bar'; echo foo > $file;" +prop_checkSpacefulnessCfg31= verifyNot checkSpacefulnessCfg "echo \"`echo \\\"$1\\\"`\"" +prop_checkSpacefulnessCfg32= verifyNot checkSpacefulnessCfg "var=$1; [ -v var ]" +prop_checkSpacefulnessCfg33= verify checkSpacefulnessCfg "for file; do echo $file; done" +prop_checkSpacefulnessCfg34= verify checkSpacefulnessCfg "declare foo$n=$1" +prop_checkSpacefulnessCfg35= verifyNot checkSpacefulnessCfg "echo ${1+\"$1\"}" +prop_checkSpacefulnessCfg36= verifyNot checkSpacefulnessCfg "arg=$#; echo $arg" +prop_checkSpacefulnessCfg37= verifyNot checkSpacefulnessCfg "@test 'status' {\n [ $status -eq 0 ]\n}" +prop_checkSpacefulnessCfg37v = verify checkVerboseSpacefulnessCfg "@test 'status' {\n [ $status -eq 0 ]\n}" +prop_checkSpacefulnessCfg38= verify checkSpacefulnessCfg "a=; echo $a" +prop_checkSpacefulnessCfg39= verifyNot checkSpacefulnessCfg "a=''\"\"''; b=x$a; echo $b" +prop_checkSpacefulnessCfg40= verifyNot checkSpacefulnessCfg "a=$((x+1)); echo $a" +prop_checkSpacefulnessCfg41= verifyNot checkSpacefulnessCfg "exec $1 --flags" +prop_checkSpacefulnessCfg42= verifyNot checkSpacefulnessCfg "run $1 --flags" +prop_checkSpacefulnessCfg43= verifyNot checkSpacefulnessCfg "$foo=42" +prop_checkSpacefulnessCfg44= verify checkSpacefulnessCfg "#!/bin/sh\nexport var=$value" +prop_checkSpacefulnessCfg45= verifyNot checkSpacefulnessCfg "wait -zzx -p foo; echo $foo" +prop_checkSpacefulnessCfg46= verifyNot checkSpacefulnessCfg "x=0; (( x += 1 )); echo $x" +prop_checkSpacefulnessCfg47= verifyNot checkSpacefulnessCfg "x=0; (( x-- )); echo $x" +prop_checkSpacefulnessCfg48= verifyNot checkSpacefulnessCfg "x=0; (( ++x )); echo $x" +prop_checkSpacefulnessCfg49= verifyNot checkSpacefulnessCfg "for i in 1 2 3; do echo $i; done" +prop_checkSpacefulnessCfg50= verify checkSpacefulnessCfg "for i in 1 2 *; do echo $i; done" +prop_checkSpacefulnessCfg51= verify checkSpacefulnessCfg "x='foo bar'; x && x=1; echo $x" +prop_checkSpacefulnessCfg52= verifyNot checkSpacefulnessCfg "x=1; if f; then x='foo bar'; exit; fi; echo $x" +prop_checkSpacefulnessCfg53= verifyNot checkSpacefulnessCfg "s=1; f() { local s='a b'; }; f; echo $s" +prop_checkSpacefulnessCfg54= verifyNot checkSpacefulnessCfg "s='a b'; f() { s=1; }; f; echo $s" +prop_checkSpacefulnessCfg55= verify checkSpacefulnessCfg "s='a b'; x && f() { s=1; }; f; echo $s" +prop_checkSpacefulnessCfg56= verifyNot checkSpacefulnessCfg "s=1; cat <(s='a b'); echo $s" + +checkSpacefulnessCfg = checkSpacefulnessCfg' True +checkVerboseSpacefulnessCfg = checkSpacefulnessCfg' False + +checkSpacefulnessCfg' :: Bool -> (Parameters -> Token -> Writer [TokenComment] ()) +checkSpacefulnessCfg' dirtyPass params token@(T_DollarBraced id _ list) = + when (needsQuoting && (dirtyPass == not isClean)) $ + unless (name `elem` specialVariablesWithoutSpaces || quotesMayConflictWithSC2281 params token) $ + if dirtyPass + then + if isDefaultAssignment (parentMap params) token + then + info (getId token) 2223 + "This default assignment may cause DoS due to globbing. Quote it." + else + infoWithFix id 2086 "Double quote to prevent globbing and word splitting." $ + addDoubleQuotesAround params token + else + styleWithFix id 2248 "Prefer double quoting even when variables don't contain special characters." $ + addDoubleQuotesAround params token + where - defaults = zip variablesWithoutSpaces (repeat SpaceNone) - - hasSpaces name = gets (Map.findWithDefault SpaceSome name) - - setSpaces name status = - modify $ Map.insert name status - - readF _ token name = do - spaces <- hasSpaces name - let needsQuoting = - isExpansion token - && not (isArrayExpansion token) -- There's another warning for this - && not (isCountingReference token) - && not (isQuoteFree (shellType params) parents token) - && not (isQuotedAlternativeReference token) - && not (usedAsCommandName parents token) - - return . execWriter $ when needsQuoting $ onFind spaces token name - - where - emit x = tell [x] - - writeF _ _ name (DataString SourceExternal) = setSpaces name SpaceSome >> return [] - writeF _ _ name (DataString SourceInteger) = setSpaces name SpaceNone >> return [] - - writeF _ _ name (DataString (SourceFrom vals)) = do - map <- get - setSpaces name - (isSpacefulWord (\x -> Map.findWithDefault SpaceSome x map) vals) - return [] - - writeF _ _ _ _ = return [] - + name = getBracedReference $ concat $ oversimplify list parents = parentMap params + needsQuoting = + not (isArrayExpansion token) -- There's another warning for this + && not (isCountingReference token) + && not (isQuoteFree (shellType params) parents token) + && not (isQuotedAlternativeReference token) + && not (usedAsCommandName parents token) - isExpansion t = - case t of - (T_DollarBraced _ _ _ ) -> True - _ -> False + isClean = fromMaybe False $ do + state <- CF.getIncomingState (cfgAnalysis params) id + value <- Map.lookup name $ CF.variablesInScope state + return $ CF.spaceStatus value == CF.SpaceStatusClean + + isDefaultAssignment parents token = + let modifier = getBracedModifier $ bracedString token in + any (`isPrefixOf` modifier) ["=", ":="] + && isParamTo parents ":" token + + -- Given a T_DollarBraced, return a simplified version of the string contents. + bracedString (T_DollarBraced _ _ l) = concat $ oversimplify l + bracedString _ = error $ pleaseReport "bracedString on non-variable" + +checkSpacefulnessCfg' _ _ _ = return () - isSpacefulWord :: (String -> SpaceStatus) -> [Token] -> SpaceStatus - isSpacefulWord f = mconcat . map (isSpaceful f) - isSpaceful :: (String -> SpaceStatus) -> Token -> SpaceStatus - isSpaceful spacefulF x = - case x of - T_DollarExpansion _ _ -> SpaceSome - T_Backticked _ _ -> SpaceSome - T_Glob _ _ -> SpaceSome - T_Extglob {} -> SpaceSome - T_DollarArithmetic _ _ -> SpaceNone - T_Literal _ s -> fromLiteral s - T_SingleQuoted _ s -> fromLiteral s - T_DollarBraced _ _ l -> spacefulF $ getBracedReference $ concat $ oversimplify l - T_NormalWord _ w -> isSpacefulWord spacefulF w - T_DoubleQuoted _ w -> isSpacefulWord spacefulF w - _ -> SpaceEmpty - where - globspace = "*?[] \t\n" - containsAny s = any (`elem` s) - fromLiteral "" = SpaceEmpty - fromLiteral s | s `containsAny` globspace = SpaceSome - fromLiteral _ = SpaceNone prop_CheckVariableBraces1 = verify checkVariableBraces "a='123'; echo $a" prop_CheckVariableBraces2 = verifyNot checkVariableBraces "a='123'; echo ${a}" From 8dc0fdb4cc3ae7cdea693b5dd2bead54fad7422e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Wed, 20 Jul 2022 12:43:28 -0700 Subject: [PATCH 026/244] Precompile new fgl dependency on armv6hf --- build/linux.armv6hf/Dockerfile | 1 + 1 file changed, 1 insertion(+) diff --git a/build/linux.armv6hf/Dockerfile b/build/linux.armv6hf/Dockerfile index bd5795c..f933dda 100644 --- a/build/linux.armv6hf/Dockerfile +++ b/build/linux.armv6hf/Dockerfile @@ -52,6 +52,7 @@ RUN pirun apt-get install -y ghc cabal-install ENV CABALOPTS "--ghc-options;-split-sections -optc-Os -optc-Wl,--gc-sections;--gcc-options;-Os -Wl,--gc-sections -ffunction-sections -fdata-sections" RUN pirun cabal update RUN IFS=";" && pirun cabal install --dependencies-only $CABALOPTS ShellCheck +RUN IFS=';' && pirun cabal install $CABALOPTS --lib fgl # Copy the build script WORKDIR /pi/scratch From 3ee4419ef4f4cda211401b1e97898dda5eb2e684 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 21 Jul 2022 15:06:05 -0700 Subject: [PATCH 027/244] Suppress SC2086 for variables declared -i (ref #2541) --- CHANGELOG.md | 1 + src/ShellCheck/Analytics.hs | 16 +- src/ShellCheck/CFG.hs | 102 ++++++---- src/ShellCheck/CFGAnalysis.hs | 365 ++++++++++++++++++++++++++-------- 4 files changed, 358 insertions(+), 126 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 66d5369..7da6077 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ ### Fixed - SC2086: Now uses DFA to make more accurate predictions about values +- SC2086: No longer warns about values declared as integer with declare -i ### Changed - ShellCheck now has a Data Flow Analysis engine to make smarter decisions diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 0062879..ca918ba 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -24,6 +24,7 @@ module ShellCheck.Analytics (runAnalytics, optionalChecks, ShellCheck.Analytics. import ShellCheck.AST import ShellCheck.ASTLib import ShellCheck.AnalyzerLib hiding (producesComments) +import ShellCheck.CFG import qualified ShellCheck.CFGAnalysis as CF import ShellCheck.Data import ShellCheck.Parser @@ -46,6 +47,7 @@ import Data.Ord import Data.Semigroup import Debug.Trace -- STRIP import qualified Data.Map.Strict as Map +import qualified Data.Set as S import Test.QuickCheck.All (forAllProperties) import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess) @@ -2076,6 +2078,14 @@ prop_checkSpacefulnessCfg53= verifyNot checkSpacefulnessCfg "s=1; f() { local s= prop_checkSpacefulnessCfg54= verifyNot checkSpacefulnessCfg "s='a b'; f() { s=1; }; f; echo $s" prop_checkSpacefulnessCfg55= verify checkSpacefulnessCfg "s='a b'; x && f() { s=1; }; f; echo $s" prop_checkSpacefulnessCfg56= verifyNot checkSpacefulnessCfg "s=1; cat <(s='a b'); echo $s" +prop_checkSpacefulnessCfg57= verifyNot checkSpacefulnessCfg "declare -i s=0; s=$(f); echo $s" +prop_checkSpacefulnessCfg58= verify checkSpacefulnessCfg "f() { declare -i s; }; f; s=$(var); echo $s" +prop_checkSpacefulnessCfg59= verifyNot checkSpacefulnessCfg "f() { declare -gi s; }; f; s=$(var); echo $s" +prop_checkSpacefulnessCfg60= verify checkSpacefulnessCfg "declare -i s; declare +i s; s=$(foo); echo $s" +prop_checkSpacefulnessCfg61= verify checkSpacefulnessCfg "declare -x X; y=foo$X; echo $y;" +prop_checkSpacefulnessCfg62= verifyNot checkSpacefulnessCfg "f() { declare -x X; y=foo$X; echo $y; }" +prop_checkSpacefulnessCfg63= verify checkSpacefulnessCfg "f && declare -i s; s='x + y'; echo $s" +prop_checkSpacefulnessCfg64= verifyNot checkSpacefulnessCfg "declare -i s; s='x + y'; x=$s; echo $x" checkSpacefulnessCfg = checkSpacefulnessCfg' True checkVerboseSpacefulnessCfg = checkSpacefulnessCfg' False @@ -2110,7 +2120,11 @@ checkSpacefulnessCfg' dirtyPass params token@(T_DollarBraced id _ list) = isClean = fromMaybe False $ do state <- CF.getIncomingState (cfgAnalysis params) id value <- Map.lookup name $ CF.variablesInScope state - return $ CF.spaceStatus value == CF.SpaceStatusClean + return $ isCleanState value + + isCleanState state = + (all (S.member CFVPInteger) $ CF.variableProperties state) + || CF.spaceStatus (CF.variableValue state) == CF.SpaceStatusClean isDefaultAssignment parents token = let modifier = getBracedModifier $ bracedString token in diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index 101a0d7..a4bd166 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -32,6 +32,7 @@ module ShellCheck.CFG ( CFGraph, CFGParameters (..), IdTagged (..), + Scope (..), buildGraph , ShellCheck.CFG.runTests -- STRIP ) @@ -105,7 +106,8 @@ data CFEdge = -- Actions we track data CFEffect = - CFModifyProps String [CFVariableProp] + CFSetProps Scope String (S.Set CFVariableProp) + | CFUnsetProps Scope String (S.Set CFVariableProp) | CFReadVariable String | CFWriteVariable String CFValue | CFWriteGlobal String CFValue @@ -143,7 +145,7 @@ data CFValue = data CFStringPart = -- A known literal string value, like 'foo' CFStringLiteral String - -- The contents of a variable, like $foo + -- The contents of a variable, like $foo (may not be a string) | CFStringVariable String -- An value that is unknown but an integer | CFStringInteger @@ -152,7 +154,7 @@ data CFStringPart = deriving (Eq, Ord, Show, Generic, NFData) -- The properties of a variable -data CFVariableProp = CFVPExport | CFVPArray +data CFVariableProp = CFVPExport | CFVPArray | CFVPAssociative | CFVPInteger deriving (Eq, Ord, Show, Generic, NFData) -- Options when generating CFG @@ -961,71 +963,92 @@ handleCommand cmd vars args literalCmd = do handleDeclare (cmd:args) = do isFunc <- asks cfIsFunction - let (evaluated, effects) = mconcat $ map (toEffects isFunc) args + -- This is a bit of a kludge: we don't have great support for things like + -- 'declare -i x=$x' so do one round with declare x=$x, followed by declare -i x + let (evaluated, assignments, added, removed) = mconcat $ map (toEffects isFunc) args before <- sequentially $ evaluated - effect <- newNodeRange $ CFApplyEffects effects + assignments <- newNodeRange $ CFApplyEffects assignments + addedProps <- if null added then newStructuralNode else newNodeRange $ CFApplyEffects added + removedProps <- if null removed then newStructuralNode else newNodeRange $ CFApplyEffects removed result <- newNodeRange $ CFSetExitCode (getId cmd) - linkRanges [before, effect, result] + linkRanges [before, assignments, addedProps, removedProps, result] where opts = map fst $ getGenericOpts args - array = "a" `elem` opts || "A" `elem` opts + array = "a" `elem` opts || associative + associative = "A" `elem` opts integer = "i" `elem` opts func = "f" `elem` opts || "F" `elem` opts global = "g" `elem` opts + export = "x" `elem` opts writer isFunc = case () of _ | global -> CFWriteGlobal _ | isFunc -> CFWriteLocal _ -> CFWriteVariable - toEffects :: Bool -> Token -> ([Token], [IdTagged CFEffect]) + scope isFunc = + case () of + _ | global -> GlobalScope + _ | isFunc -> LocalScope + _ -> DefaultScope + + addedProps = S.fromList $ concat $ [ + [ CFVPArray | array ], + [ CFVPInteger | integer ], + [ CFVPExport | export ], + [ CFVPAssociative | associative ] + ] + + removedProps = S.fromList $ concat $ [ + -- Array property can't be unset + [ CFVPInteger | 'i' `elem` unsetOptions ], + [ CFVPExport | 'e' `elem` unsetOptions ] + ] + toEffects isFunc (T_Assignment id mode var idx t) = let pre = idx ++ [t] - isArray = array || (not $ null idx) - asArray = [ IdTagged id $ (writer isFunc) var CFValueArray ] - asString = [ IdTagged id $ (writer isFunc) var $ - if integer - then CFValueInteger -- TODO: Also handle integer variable property - else CFValueComputed (getId t) $ [ CFStringVariable var | mode == Append ] ++ tokenToParts t - ] + val = [ IdTagged id $ (writer isFunc) var $ CFValueComputed (getId t) $ [ CFStringVariable var | mode == Append ] ++ tokenToParts t ] + added = [ IdTagged id $ CFSetProps (scope isFunc) var addedProps | not $ S.null addedProps ] + removed = [ IdTagged id $ CFUnsetProps (scope isFunc) var addedProps | not $ S.null removedProps ] in - (pre, if isArray then asArray else asString ) + (pre, val, added, removed) toEffects isFunc t = let + id = getId t pre = [t] literal = fromJust $ getLiteralStringExt (const $ Just "\0") t isKnown = '\0' `notElem` literal match = fmap head $ variableAssignRegex `matchRegex` literal name = fromMaybe literal match - typer def = - if array - then CFValueArray - else - if integer - then CFValueInteger - else def + asLiteral = + IdTagged id $ (writer isFunc) name $ + CFValueComputed (getId t) [ CFStringLiteral $ drop 1 $ dropWhile (/= '=') $ literal ] + asUnknown = + IdTagged id $ (writer isFunc) name $ + CFValueString + + added = [ IdTagged id $ CFSetProps (scope isFunc) name addedProps ] + removed = [ IdTagged id $ CFUnsetProps (scope isFunc) name removedProps ] - asLiteral = [ - IdTagged (getId t) $ (writer isFunc) name $ - typer $ CFValueComputed (getId t) [ CFStringLiteral $ drop 1 $ dropWhile (/= '=') $ literal ] - ] - asUnknown = [ - IdTagged (getId t) $ (writer isFunc) name $ - typer $ CFValueString - ] - asBlank = [ - IdTagged (getId t) $ (writer isFunc) name $ - typer $ CFValueComputed (getId t) [] - ] in case () of - _ | not (isVariableName name) -> (pre, []) - _ | isJust match && isKnown -> (pre, asLiteral) - _ | isJust match -> (pre, asUnknown) - _ -> (pre, asBlank) + _ | not (isVariableName name) -> (pre, [], [], []) + _ | isJust match && isKnown -> (pre, [asLiteral], added, removed) + _ | isJust match -> (pre, [asUnknown], added, removed) + -- e.g. declare -i x + _ -> (pre, [], added, removed) + + -- find "ia" from `define +i +a` + unsetOptions :: String + unsetOptions = + let + strings = mapMaybe getLiteralString args + plusses = filter ("+" `isPrefixOf`) strings + in + concatMap (drop 1) plusses handlePrintf (cmd:args) = newNodeRange $ CFApplyEffects $ maybeToList findVar @@ -1103,6 +1126,7 @@ handleCommand cmd vars args literalCmd = do none = newStructuralNode data Scope = DefaultScope | GlobalScope | LocalScope | PrefixScope + deriving (Eq, Ord, Show, Generic, NFData) buildAssignment scope t = do op <- case t of diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 99ce450..0007a67 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -50,7 +50,9 @@ module ShellCheck.CFGAnalysis ( ,CFGParameters (..) ,CFGAnalysis (..) ,ProgramState (..) + ,VariableState (..) ,VariableValue (..) + ,VariableProperties ,SpaceStatus (..) ,getIncomingState ,getOutgoingState @@ -77,9 +79,21 @@ import Debug.Trace -- STRIP import Test.QuickCheck +-- The number of iterations for DFA to stabilize iterationCount = 1000000 +-- There have been multiple bugs where bad caching caused oscillations. +-- As a precaution, disable caching if there's this many iterations left. +fallbackThreshold = 10000 +-- The number of cache entries to keep per node cacheEntries = 10 +logVerbose log = do + -- traceShowM log + return () +logInfo log = do + -- traceShowM log + return () + -- The result of the data flow analysis data CFGAnalysis = CFGAnalysis { graph :: CFGraph, @@ -89,9 +103,9 @@ data CFGAnalysis = CFGAnalysis { -- The program state we expose externally data ProgramState = ProgramState { - variablesInScope :: M.Map String VariableValue, +-- internalState :: InternalState, -- For debugging + variablesInScope :: M.Map String VariableState, stateIsReachable :: Bool --- internalState :: InternalState } deriving (Show, Eq, Generic, NFData) -- Conveniently get the state before a token id @@ -111,9 +125,9 @@ getDataForNode analysis node = M.lookup node $ nodeToData analysis -- The current state of data flow at a point in the program, potentially as a diff data InternalState = InternalState { sVersion :: Integer, - sGlobalValues :: VersionedMap String VariableValue, - sLocalValues :: VersionedMap String VariableValue, - sPrefixValues :: VersionedMap String VariableValue, + sGlobalValues :: VersionedMap String VariableState, + sLocalValues :: VersionedMap String VariableState, + sPrefixValues :: VersionedMap String VariableState, sFunctionTargets :: VersionedMap String FunctionValue, sIsReachable :: Maybe Bool } deriving (Show, Generic, NFData) @@ -135,31 +149,33 @@ unreachableState = modified newInternalState { createEnvironmentState :: InternalState createEnvironmentState = do foldl' (flip ($)) newInternalState $ concat [ - addVars Data.internalVariables unknownVariableValue, - addVars Data.variablesWithoutSpaces spacelessVariableValue, - addVars Data.specialIntegerVariables spacelessVariableValue + addVars Data.internalVariables unknownVariableState, + addVars Data.variablesWithoutSpaces spacelessVariableState, + addVars Data.specialIntegerVariables spacelessVariableState ] where addVars names val = map (\name -> insertGlobal name val) names - spacelessVariableValue = VariableValue { - literalValue = Nothing, - spaceStatus = SpaceStatusClean + spacelessVariableState = unknownVariableState { + variableValue = VariableValue { + literalValue = Nothing, + spaceStatus = SpaceStatusClean + } } modified s = s { sVersion = -1 } -insertGlobal :: String -> VariableValue -> InternalState -> InternalState +insertGlobal :: String -> VariableState -> InternalState -> InternalState insertGlobal name value state = modified state { sGlobalValues = vmInsert name value $ sGlobalValues state } -insertLocal :: String -> VariableValue -> InternalState -> InternalState +insertLocal :: String -> VariableState -> InternalState -> InternalState insertLocal name value state = modified state { sLocalValues = vmInsert name value $ sLocalValues state } -insertPrefix :: String -> VariableValue -> InternalState -> InternalState +insertPrefix :: String -> VariableState -> InternalState -> InternalState insertPrefix name value state = modified state { sPrefixValues = vmInsert name value $ sPrefixValues state } @@ -169,24 +185,38 @@ insertFunction name value state = modified state { sFunctionTargets = vmInsert name value $ sFunctionTargets state } +addProperties :: S.Set CFVariableProp -> VariableState -> VariableState +addProperties props state = state { + variableProperties = S.map (S.union props) $ variableProperties state +} + +removeProperties :: S.Set CFVariableProp -> VariableState -> VariableState +removeProperties props state = state { + variableProperties = S.map (\s -> S.difference s props) $ variableProperties state +} + internalToExternal :: InternalState -> ProgramState internalToExternal s = ProgramState { - -- Avoid introducing dependencies on the literal value as this is only for debugging purposes right now - variablesInScope = M.map (\c -> c { literalValue = Nothing }) flatVars, + -- Censor the literal value to avoid introducing dependencies on it. It's just for debugging. + variablesInScope = M.map censor flatVars, -- internalState = s, -- For debugging stateIsReachable = fromMaybe True $ sIsReachable s } where + censor s = s { + variableValue = (variableValue s) { + literalValue = Nothing + } + } flatVars = M.unionsWith (\_ last -> last) $ map mapStorage [sGlobalValues s, sLocalValues s, sPrefixValues s] -- Dependencies on values, e.g. "if there is a global variable named 'foo' without spaces" -- This is used to see if the DFA of a function would result in the same state, so anything -- that affects DFA must be tracked. data StateDependency = - DepGlobalValue String VariableValue - | DepLocalValue String VariableValue - | DepPrefixValue String VariableValue + DepState Scope String VariableState + | DepProperties Scope String VariableProperties | DepFunction String (S.Set FunctionDefinition) -- Whether invoking the node would result in recursion (i.e., is the function on the stack?) | DepIsRecursive Node Bool @@ -199,10 +229,6 @@ data FunctionDefinition = FunctionUnknown | FunctionDefinition String Node Node -- The Set of places a command name can point (it's a Set to handle conditionally defined functions) type FunctionValue = S.Set FunctionDefinition --- The scope of a function. ("Prefix" refers to e.g. `foo=1 env`) -data VariableScope = PrefixVar | LocalVar | GlobalVar - deriving (Show, Eq, Ord, Generic, NFData) - -- Create an InternalState that fulfills the given dependencies depsToState :: S.Set StateDependency -> InternalState depsToState set = foldl insert newInternalState $ S.toList set @@ -211,11 +237,26 @@ depsToState set = foldl insert newInternalState $ S.toList set insert state dep = case dep of DepFunction name val -> insertFunction name val state - DepGlobalValue name val -> insertGlobal name val state - DepLocalValue name val -> insertLocal name val state - DepPrefixValue name val -> insertPrefix name val state + DepState scope name val -> insertIn True scope name val state + -- State includes properties and more, so don't overwrite a state with properties + DepProperties scope name props -> insertIn False scope name unknownVariableState { variableProperties = props } state DepIsRecursive _ _ -> state + insertIn overwrite scope name val state = + let + (mapToCheck, inserter) = + case scope of + PrefixScope -> (sPrefixValues, insertPrefix) + LocalScope -> (sLocalValues, insertLocal) + GlobalScope -> (sGlobalValues, insertGlobal) + DefaultScope -> error $ pleaseReport "Unresolved scope in dependency" + + alreadyExists = isJust $ vmLookup name $ mapToCheck state + in + if overwrite || not alreadyExists + then inserter name val state + else state + unknownFunctionValue = S.singleton FunctionUnknown -- The information about the value of a single variable @@ -225,20 +266,45 @@ data VariableValue = VariableValue { } deriving (Show, Eq, Ord, Generic, NFData) +data VariableState = VariableState { + variableValue :: VariableValue, + variableProperties :: VariableProperties +} + deriving (Show, Eq, Ord, Generic, NFData) + -- Whether or not the value needs quoting (has spaces/globs), or we don't know data SpaceStatus = SpaceStatusEmpty | SpaceStatusClean | SpaceStatusDirty deriving (Show, Eq, Ord, Generic, NFData) +-- The set of possible sets of properties for this variable +type VariableProperties = S.Set (S.Set CFVariableProp) + +defaultProperties = S.singleton S.empty + +unknownVariableState = VariableState { + variableValue = unknownVariableValue, + variableProperties = defaultProperties +} unknownVariableValue = VariableValue { literalValue = Nothing, spaceStatus = SpaceStatusDirty } -emptyVariableValue = VariableValue { +emptyVariableValue = unknownVariableValue { literalValue = Just "", spaceStatus = SpaceStatusEmpty } +unsetVariableState = VariableState { + variableValue = emptyVariableValue, + variableProperties = defaultProperties +} + +mergeVariableState a b = VariableState { + variableValue = mergeVariableValue (variableValue a) (variableValue b), + variableProperties = S.union (variableProperties a) (variableProperties b) +} + mergeVariableValue a b = VariableValue { literalValue = if literalValue a == literalValue b then literalValue a else Nothing, spaceStatus = mergeSpaceStatus (spaceStatus a) (spaceStatus b) @@ -296,6 +362,8 @@ data Ctx s = Ctx { cCounter :: STRef s Integer, -- A cache of input state dependencies to output effects cCache :: STRef s (M.Map Node [(S.Set StateDependency, InternalState)]), + -- Whether the cache is enabled (see fallbackThreshold) + cEnableCache :: STRef s Bool, -- The states resulting from data flows per invocation path cInvocations :: STRef s (M.Map [Node] (S.Set StateDependency, M.Map Node (InternalState, InternalState))) } @@ -304,6 +372,8 @@ data Ctx s = Ctx { data StackEntry s = StackEntry { -- The entry point of this stack entry for the purpose of detecting recursion entryPoint :: Node, + -- Whether this is a function call (as opposed to a subshell) + isFunctionCall :: Bool, -- The node where this entry point was invoked callSite :: Node, -- A mutable set of dependencies we fetched from here or higher in the stack @@ -369,9 +439,9 @@ mergeState ctx a b = do return unreachableState _ | sVersion a >= 0 && sVersion b >= 0 && sVersion a == sVersion b -> return a _ -> do - globals <- mergeMaps ctx mergeVariableValue readGlobal (sGlobalValues a) (sGlobalValues b) - locals <- mergeMaps ctx mergeVariableValue readVariable (sLocalValues a) (sLocalValues b) - prefix <- mergeMaps ctx mergeVariableValue readVariable (sPrefixValues a) (sPrefixValues b) + globals <- mergeMaps ctx mergeVariableState readGlobal (sGlobalValues a) (sGlobalValues b) + locals <- mergeMaps ctx mergeVariableState readVariable (sLocalValues a) (sLocalValues b) + prefix <- mergeMaps ctx mergeVariableState readVariable (sPrefixValues a) (sPrefixValues b) funcs <- mergeMaps ctx S.union readFunction (sFunctionTargets a) (sFunctionTargets b) return $ InternalState { sVersion = -1, @@ -517,15 +587,15 @@ vmPatch base diff = mapStorage = M.unionWith (flip const) (mapStorage base) (mapStorage diff) } --- Modify a variable as with x=1. This applies it to the appropriate scope. -writeVariable :: forall s. Ctx s -> String -> VariableValue -> ST s () +-- Set a variable. This includes properties. Applies it to the appropriate scope. +writeVariable :: forall s. Ctx s -> String -> VariableState -> ST s () writeVariable ctx name val = do - (_, typ) <- readVariableWithScope ctx name + typ <- readVariableScope ctx name case typ of - GlobalVar -> writeGlobal ctx name val - LocalVar -> writeLocal ctx name val + GlobalScope -> writeGlobal ctx name val + LocalScope -> writeLocal ctx name val -- Prefixed variables actually become local variables in the invoked function - PrefixVar -> writeLocal ctx name val + PrefixScope -> writeLocal ctx name val writeGlobal ctx name val = do modifySTRef (cOutput ctx) $ insertGlobal name val @@ -536,39 +606,97 @@ writeLocal ctx name val = do writePrefix ctx name val = do modifySTRef (cOutput ctx) $ insertPrefix name val +updateVariableValue ctx name val = do + (props, scope) <- readVariablePropertiesWithScope ctx name + let f = case scope of + GlobalScope -> writeGlobal + LocalScope -> writeLocal + PrefixScope -> writeLocal -- Updates become local + f ctx name $ VariableState { variableValue = val, variableProperties = props } + +updateGlobalValue ctx name val = do + props <- readGlobalProperties ctx name + writeGlobal ctx name VariableState { variableValue = val, variableProperties = props } + +updateLocalValue ctx name val = do + props <- readLocalProperties ctx name + writeLocal ctx name VariableState { variableValue = val, variableProperties = props } + +updatePrefixValue ctx name val = do + -- Prefix variables don't inherit properties + writePrefix ctx name VariableState { variableValue = val, variableProperties = defaultProperties } + + -- Look up a variable value, and also return its scope -readVariableWithScope :: forall s. Ctx s -> String -> ST s (VariableValue, VariableScope) +readVariableWithScope :: forall s. Ctx s -> String -> ST s (VariableState, Scope) readVariableWithScope ctx name = lookupStack get dep def ctx name where - def = (unknownVariableValue, GlobalVar) + def = (unknownVariableState, GlobalScope) get = getVariableWithScope - dep k v = - case v of - (val, GlobalVar) -> DepGlobalValue k val - (val, LocalVar) -> DepLocalValue k val - (val, PrefixVar) -> DepPrefixValue k val + dep k (val, scope) = DepState scope k val -getVariableWithScope :: InternalState -> String -> Maybe (VariableValue, VariableScope) +-- Look up the variable's properties. This can be done independently to avoid incurring a dependency on the value. +readVariablePropertiesWithScope :: forall s. Ctx s -> String -> ST s (VariableProperties, Scope) +readVariablePropertiesWithScope ctx name = lookupStack get dep def ctx name + where + def = (defaultProperties, GlobalScope) + get s k = do + (val, scope) <- getVariableWithScope s k + return (variableProperties val, scope) + dep k (val, scope) = DepProperties scope k val + +readVariableScope ctx name = snd <$> readVariablePropertiesWithScope ctx name + +getVariableWithScope :: InternalState -> String -> Maybe (VariableState, Scope) getVariableWithScope s name = case (vmLookup name $ sPrefixValues s, vmLookup name $ sLocalValues s, vmLookup name $ sGlobalValues s) of - (Just var, _, _) -> return (var, PrefixVar) - (_, Just var, _) -> return (var, LocalVar) - (_, _, Just var) -> return (var, GlobalVar) + (Just var, _, _) -> return (var, PrefixScope) + (_, Just var, _) -> return (var, LocalScope) + (_, _, Just var) -> return (var, GlobalScope) _ -> Nothing undefineFunction ctx name = writeFunction ctx name $ FunctionUnknown undefineVariable ctx name = - writeVariable ctx name $ emptyVariableValue + writeVariable ctx name $ unsetVariableState readVariable ctx name = fst <$> readVariableWithScope ctx name +readVariableProperties ctx name = fst <$> readVariablePropertiesWithScope ctx name readGlobal ctx name = lookupStack get dep def ctx name where - def = unknownVariableValue + def = unknownVariableState -- could come from the environment get s name = vmLookup name $ sGlobalValues s - dep k v = DepGlobalValue k v + dep k v = DepState GlobalScope k v + + +readGlobalProperties ctx name = lookupStack get dep def ctx name + where + def = defaultProperties + get s name = variableProperties <$> (vmLookup name $ sGlobalValues s) + -- This dependency will fail to match if it's shadowed by a local variable, + -- such as in x=1; f() { local -i x; declare -ag x; } because we'll look at + -- x and find it to be local and not global. FIXME? + dep k v = DepProperties GlobalScope k v + +readLocal ctx name = lookupStackUntilFunction get dep def ctx name + where + def = unsetVariableState -- can't come from the environment + get s name = vmLookup name $ sLocalValues s + dep k v = DepState LocalScope k v + +-- We only want to look up the local properties of the current function, +-- though preferably even if we're in a subshell. FIXME? +readLocalProperties ctx name = fst <$> lookupStackUntilFunction get dep def ctx name + where + def = (defaultProperties, LocalScope) + with tag f = do + val <- variableProperties <$> f + return (val, tag) + + get s name = (with LocalScope $ vmLookup name $ sLocalValues s) `mplus` (with PrefixScope $ vmLookup name $ sPrefixValues s) + dep k (val, scope) = DepProperties scope k val readFunction ctx name = lookupStack get dep def ctx name where @@ -581,9 +709,11 @@ writeFunction ctx name val = do -- Look up each state on the stack until a value is found (or the default is used), -- then add this value as a StateDependency. -lookupStack :: forall s k v. +lookupStack' :: forall s k v. + -- Whether to stop at function boundaries + Bool -- A function that maybe finds a value from a state - (InternalState -> k -> Maybe v) + -> (InternalState -> k -> Maybe v) -- A function that creates a dependency on what was found -> (k -> v -> StateDependency) -- A default value, if the value can't be found anywhere @@ -594,13 +724,14 @@ lookupStack :: forall s k v. -> k -- Returning the result -> ST s v -lookupStack get dep def ctx key = do +lookupStack' functionOnly get dep def ctx key = do top <- readSTRef $ cInput ctx case get top key of Just v -> return v Nothing -> f (cStack ctx) where f [] = return def + f (s:_) | functionOnly && isFunctionCall s = return def f (s:rest) = do -- Go up the stack until we find the value, and add -- a dependency on each state (including where it was found) @@ -608,6 +739,9 @@ lookupStack get dep def ctx key = do modifySTRef (dependencies s) $ S.insert $ dep key res return res +lookupStack = lookupStack' False +lookupStackUntilFunction = lookupStack' True + -- Like lookupStack but without adding dependencies peekStack get def ctx key = do top <- readSTRef $ cInput ctx @@ -621,26 +755,30 @@ peekStack get def ctx key = do Just v -> return v Nothing -> f rest --- Check if the current context fulfills a StateDependency -fulfillsDependency ctx dep = +-- Check if the current context fulfills a StateDependency if entering `entry` +fulfillsDependency ctx entry dep = case dep of - DepGlobalValue name val -> (== (val, GlobalVar)) <$> peek ctx name - DepLocalValue name val -> (== (val, LocalVar)) <$> peek ctx name - DepPrefixValue name val -> (== (val, PrefixVar)) <$> peek ctx name + DepState scope name val -> (== (val, scope)) <$> peek scope ctx name + DepProperties scope name props -> do + (state, s) <- peek scope ctx name + return $ scope == s && variableProperties state == props DepFunction name val -> (== val) <$> peekFunc ctx name + -- Hack. Since we haven't pushed the soon-to-be invoked function on the stack, + -- it won't be found by the normal check. + DepIsRecursive node val | node == entry -> return True DepIsRecursive node val -> return $ val == any (\f -> entryPoint f == node) (cStack ctx) -- _ -> error $ "Unknown dep " ++ show dep where - peek = peekStack getVariableWithScope (unknownVariableValue, GlobalVar) + peek scope = peekStack getVariableWithScope $ if scope == GlobalScope then (unknownVariableState, GlobalScope) else (unsetVariableState, LocalScope) peekFunc = peekStack (\state name -> vmLookup name $ sFunctionTargets state) unknownFunctionValue -- Check if the current context fulfills all StateDependencies -fulfillsDependencies ctx deps = +fulfillsDependencies ctx entry deps = f $ S.toList deps where f [] = return True f (dep:rest) = do - res <- fulfillsDependency ctx dep + res <- fulfillsDependency ctx entry dep if res then f rest else return False @@ -652,6 +790,7 @@ newCtx g = do output <- newSTRef undefined node <- newSTRef undefined cache <- newSTRef M.empty + enableCache <- newSTRef True invocations <- newSTRef M.empty return $ Ctx { cCounter = c, @@ -659,6 +798,7 @@ newCtx g = do cOutput = output, cNode = node, cCache = cache, + cEnableCache = enableCache, cStack = [], cInvocations = invocations, cGraph = g @@ -672,20 +812,21 @@ nextVersion ctx = do return n -- Create a new StackEntry -newStackEntry ctx point = do +newStackEntry ctx point isCall = do deps <- newSTRef S.empty state <- readSTRef $ cOutput ctx callsite <- readSTRef $ cNode ctx return $ StackEntry { entryPoint = point, + isFunctionCall = isCall, callSite = callsite, dependencies = deps, stackState = state } -- Call a function with a new stack entry on the stack -withNewStackFrame ctx node f = do - newEntry <- newStackEntry ctx node +withNewStackFrame ctx node isCall f = do + newEntry <- newStackEntry ctx node isCall newInput <- newSTRef newInternalState newOutput <- newSTRef newInternalState newNode <- newSTRef node @@ -753,7 +894,7 @@ transferSubshell ctx reason entry exit = do writeSTRef cout initial where f entry exit ctx = do - (states, frame) <- withNewStackFrame ctx entry (flip dataflow $ entry) + (states, frame) <- withNewStackFrame ctx entry False (flip dataflow $ entry) let (_, res) = fromMaybe (error $ pleaseReport "Subshell has no exit") $ M.lookup exit states deps <- readSTRef $ dependencies frame registerFlowResult ctx entry states deps @@ -763,12 +904,12 @@ transferSubshell ctx reason entry exit = do transferCommand ctx Nothing = return () transferCommand ctx (Just name) = do targets <- readFunction ctx name - --traceShowM ("Transferring ",name,targets) + logVerbose ("Transferring ",name,targets) transferMultiple ctx $ map (flip transferFunctionValue) $ S.toList targets -- Transfer a set of function definitions and merge the output states. transferMultiple ctx funcs = do --- traceShowM ("Transferring set of ", length funcs) + logVerbose ("Transferring set of ", length funcs) original <- readSTRef out branches <- mapM (apply ctx original) funcs merged <- mergeStates ctx original branches @@ -792,7 +933,7 @@ transferFunctionValue ctx funcVal = else runCached ctx entry (f name entry exit) where f name entry exit ctx = do - (states, frame) <- withNewStackFrame ctx entry (flip dataflow $ entry) + (states, frame) <- withNewStackFrame ctx entry True (flip dataflow $ entry) deps <- readSTRef $ dependencies frame let res = case M.lookup exit states of @@ -827,25 +968,31 @@ runCached ctx node f = do cache <- getCache ctx node case cache of Just v -> do - -- traceShowM $ ("Running cached", node) + logInfo ("Running cached", node) + -- do { (deps, diff) <- f ctx; unless (v == diff) $ traceShowM ("Cache FAILED to match actual result", node, deps, diff); } patchOutputM ctx v + Nothing -> do - -- traceShowM $ ("Cache failed", node) + logInfo ("Cache failed", node) (deps, diff) <- f ctx modifySTRef (cCache ctx) (M.insertWith (\_ old -> (deps, diff):(take cacheEntries old)) node [(deps,diff)]) - -- traceShowM $ ("Recomputed cache for", node, deps) + logVerbose ("Recomputed cache for", node, deps) + -- do { f <- fulfillsDependencies ctx node deps; unless (f) $ traceShowM ("New dependencies FAILED to match", node, deps); } patchOutputM ctx diff -- Get a cached version whose dependencies are currently fulfilled, if any. getCache :: forall s. Ctx s -> Node -> ST s (Maybe InternalState) getCache ctx node = do cache <- readSTRef $ cCache ctx - -- traceShowM $ ("Cache for", node, "length", length $ M.findWithDefault [] node cache, M.lookup node cache) - f $ M.findWithDefault [] node cache + enable <- readSTRef $ cEnableCache ctx + logVerbose ("Cache for", node, "length", length $ M.findWithDefault [] node cache, M.lookup node cache) + if enable + then f $ M.findWithDefault [] node cache + else return Nothing where f [] = return Nothing f ((deps, value):rest) = do - match <- fulfillsDependencies ctx deps + match <- fulfillsDependencies ctx node deps if match then return $ Just value else f rest @@ -857,16 +1004,52 @@ transferEffect ctx effect = void $ readVariable ctx name CFWriteVariable name value -> do val <- cfValueToVariableValue ctx value - writeVariable ctx name val + updateVariableValue ctx name val CFWriteGlobal name value -> do val <- cfValueToVariableValue ctx value - writeGlobal ctx name val + updateGlobalValue ctx name val CFWriteLocal name value -> do val <- cfValueToVariableValue ctx value - writeLocal ctx name val + updateLocalValue ctx name val CFWritePrefix name value -> do val <- cfValueToVariableValue ctx value - writePrefix ctx name val + updatePrefixValue ctx name val + + CFSetProps scope name props -> + case scope of + DefaultScope -> do + state <- readVariable ctx name + writeVariable ctx name $ addProperties props state + GlobalScope -> do + state <- readGlobal ctx name + writeGlobal ctx name $ addProperties props state + LocalScope -> do + out <- readSTRef (cOutput ctx) + state <- readLocal ctx name + writeLocal ctx name $ addProperties props state + PrefixScope -> do + -- Prefix values become local + state <- readLocal ctx name + writeLocal ctx name $ addProperties props state + + CFUnsetProps scope name props -> + case scope of + DefaultScope -> do + state <- readVariable ctx name + writeVariable ctx name $ removeProperties props state + GlobalScope -> do + state <- readGlobal ctx name + writeGlobal ctx name $ removeProperties props state + LocalScope -> do + out <- readSTRef (cOutput ctx) + state <- readLocal ctx name + writeLocal ctx name $ removeProperties props state + PrefixScope -> do + -- Prefix values become local + state <- readLocal ctx name + writeLocal ctx name $ removeProperties props state + + CFUndefineVariable name -> undefineVariable ctx name CFUndefineFunction name -> undefineFunction ctx name CFUndefine name -> do @@ -880,11 +1063,9 @@ transferEffect ctx effect = CFUndefineNameref name -> undefineVariable ctx name CFHintArray name -> return () CFHintDefined name -> return () - CFModifyProps {} -> return () -- _ -> error $ "Unknown effect " ++ show effect - -- Transfer the CFG's idea of a value into our VariableState cfValueToVariableValue ctx val = case val of @@ -905,12 +1086,17 @@ computeValue ctx part = CFStringLiteral str -> return $ literalToVariableValue str CFStringInteger -> return unknownIntegerValue CFStringUnknown -> return unknownVariableValue - CFStringVariable name -> readVariable ctx name + CFStringVariable name -> variableStateToValue <$> readVariable ctx name + where + variableStateToValue state = + case () of + _ | all (CFVPInteger `S.member`) $ variableProperties state -> unknownIntegerValue + _ -> variableValue state -- Append two VariableValues as if with z="$x$y" appendVariableValue :: VariableValue -> VariableValue -> VariableValue appendVariableValue a b = - VariableValue { + unknownVariableValue { literalValue = liftM2 (++) (literalValue a) (literalValue b), spaceStatus = appendSpaceStatus (spaceStatus a) (spaceStatus b) } @@ -922,12 +1108,12 @@ appendSpaceStatus a b = (SpaceStatusClean, SpaceStatusClean) -> a _ ->SpaceStatusDirty -unknownIntegerValue = VariableValue { +unknownIntegerValue = unknownVariableValue { literalValue = Nothing, spaceStatus = SpaceStatusClean } -literalToVariableValue str = VariableValue { +literalToVariableValue str = unknownVariableValue { literalValue = Just str, spaceStatus = literalToSpaceStatus str } @@ -965,6 +1151,13 @@ dataflow ctx entry = do f 0 _ _ = error $ pleaseReport "DFA did not reach fix point" f n pending states = do ps <- readSTRef pending + + when (n == fallbackThreshold) $ do + -- This should never happen, but has historically been due to caching bugs. + -- Try disabling the cache and continuing. + logInfo "DFA is not stabilizing! Disabling cache." + writeSTRef (cEnableCache ctx) False + if S.null ps then return () else do @@ -1012,12 +1205,12 @@ runRoot ctx entry exit = do writeSTRef (cInput ctx) $ env writeSTRef (cOutput ctx) $ env writeSTRef (cNode ctx) $ entry - (states, frame) <- withNewStackFrame ctx entry $ \c -> dataflow c entry + (states, frame) <- withNewStackFrame ctx entry False $ \c -> dataflow c entry deps <- readSTRef $ dependencies frame registerFlowResult ctx entry states deps -- Return the final state, used to invoke functions that were declared but not invoked return $ snd $ fromMaybe (error $ pleaseReport "Missing exit state") $ M.lookup exit states - + analyzeControlFlow :: CFGParameters -> Token -> CFGAnalysis analyzeControlFlow params t = From e7f05d662ad1830cc9b4bce59a7b6767fa07d8c0 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 22 Jul 2022 10:29:19 -0700 Subject: [PATCH 028/244] In addition to start/end, track sets of nodes belonging to tokens --- src/ShellCheck/CFG.hs | 66 ++++++++++++++++++++++------------- src/ShellCheck/CFGAnalysis.hs | 12 ++++--- src/ShellCheck/Debug.hs | 2 +- 3 files changed, 50 insertions(+), 30 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index a4bd166..4906d80 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -168,8 +168,10 @@ data CFGParameters = CFGParameters { data CFGResult = CFGResult { -- The graph itself cfGraph :: CFGraph, - -- Map from Id to start/end node - cfIdToNode :: M.Map Id (Node, Node) + -- Map from Id to nominal start&end node (i.e. assuming normal execution without exits) + cfIdToRange :: M.Map Id (Node, Node), + -- A set of all nodes belonging to an Id, recursively + cfIdToNodes :: M.Map Id (S.Set Node) } deriving (Show) @@ -177,21 +179,24 @@ buildGraph :: CFGParameters -> Token -> CFGResult buildGraph params root = let (nextNode, base) = execRWS (buildRoot root) (newCFContext params) 0 - (nodes, edges, mapping) = + (nodes, edges, mapping, association) = -- renumberTopologically $ removeUnnecessaryStructuralNodes base in CFGResult { cfGraph = mkGraph nodes edges, - cfIdToNode = M.fromList mapping + cfIdToRange = M.fromList mapping, + cfIdToNodes = M.fromListWith S.union $ map (\(id, n) -> (id, S.singleton n)) association } -remapGraph remap (nodes, edges, mapping) = +remapGraph :: M.Map Node Node -> CFW -> CFW +remapGraph remap (nodes, edges, mapping, assoc) = ( map (remapNode remap) nodes, map (remapEdge remap) edges, - map (\(id, (a,b)) -> (id, (remapHelper remap a, remapHelper remap b))) mapping + map (\(id, (a,b)) -> (id, (remapHelper remap a, remapHelper remap b))) mapping, + map (\(id, n) -> (id, remapHelper remap n)) assoc ) prop_testRenumbering = @@ -200,17 +205,20 @@ prop_testRenumbering = before = ( [(1,s), (3,s), (4, s), (8,s)], [(1,3,CFEFlow), (3,4, CFEFlow), (4,8,CFEFlow)], - [(Id 0, (3,4))] + [(Id 0, (3,4))], + [(Id 1, 3), (Id 2, 4)] ) after = ( [(0,s), (1,s), (2,s), (3,s)], [(0,1,CFEFlow), (1,2, CFEFlow), (2,3,CFEFlow)], - [(Id 0, (1,2))] + [(Id 0, (1,2))], + [(Id 1, 1), (Id 2, 2)] ) in after == renumberGraph before -- Renumber the graph for prettiness, so there are no gaps in node numbers -renumberGraph g@(nodes, edges, mapping) = +renumberGraph :: CFW -> CFW +renumberGraph g@(nodes, edges, mapping, assoc) = let renumbering = M.fromList (flip zip [0..] $ sort $ map fst nodes) in remapGraph renumbering g @@ -220,17 +228,19 @@ prop_testRenumberTopologically = before = ( [(4,s), (2,s), (3, s)], [(4,2,CFEFlow), (2,3, CFEFlow)], - [(Id 0, (4,2))] + [(Id 0, (4,2))], + [] ) after = ( [(0,s), (1,s), (2,s)], [(0,1,CFEFlow), (1,2, CFEFlow)], - [(Id 0, (0,1))] + [(Id 0, (0,1))], + [] ) in after == renumberTopologically before -- Renumber the graph in topological order -renumberTopologically g@(nodes, edges, mapping) = +renumberTopologically g@(nodes, edges, mapping, assoc) = let renumbering = M.fromList (flip zip [0..] $ topsort (mkGraph nodes edges :: CFGraph)) in remapGraph renumbering g @@ -240,12 +250,14 @@ prop_testRemoveStructural = before = ( [(1,s), (2,s), (3, s), (4,s)], [(1,2,CFEFlow), (2,3, CFEFlow), (3,4,CFEFlow)], - [(Id 0, (2,3))] + [(Id 0, (2,3))], + [(Id 0, 3)] ) after = ( [(1,s), (2,s), (4,s)], [(1,2,CFEFlow), (2,4,CFEFlow)], - [(Id 0, (2,2))] + [(Id 0, (2,2))], + [(Id 0, 2)] ) in after == removeUnnecessaryStructuralNodes before @@ -255,12 +267,13 @@ prop_testRemoveStructural = -- Note in particular that we can't remove a structural node x in -- foo -> x -> bar , because then the pre/post-condition for tokens -- previously pointing to x would be wrong. -removeUnnecessaryStructuralNodes (nodes, edges, mapping) = +removeUnnecessaryStructuralNodes (nodes, edges, mapping, association) = remapGraph recursiveRemapping ( filter (\(n, _) -> n `M.notMember` recursiveRemapping) nodes, filter (`S.notMember` edgesToCollapse) edges, - mapping + mapping, + association ) where regularEdges = filter isRegularEdge edges @@ -305,8 +318,6 @@ remapNode m (node, label) = newLabel = case label of CFApplyEffects effects -> CFApplyEffects (map (remapEffect m) effects) CFExecuteSubshell s a b -> CFExecuteSubshell s (remapHelper m a) (remapHelper m b) --- CFSubShellStart reason node -> CFSubShellStart reason (remapHelper m node) - _ -> label remapEffect map old@(IdTagged id effect) = @@ -325,6 +336,7 @@ data CFContext = CFContext { cfIsCondition :: Bool, cfIsFunction :: Bool, cfLoopStack :: [(Node, Node)], + cfTokenStack :: [Id], cfExitTarget :: Maybe Node, cfReturnTarget :: Maybe Node, cfParameters :: CFGParameters @@ -333,19 +345,22 @@ newCFContext params = CFContext { cfIsCondition = False, cfIsFunction = False, cfLoopStack = [], + cfTokenStack = [], cfExitTarget = Nothing, cfReturnTarget = Nothing, cfParameters = params } -- The monad we generate a graph in -type CFM a = RWS CFContext ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))]) Int a +type CFM a = RWS CFContext CFW Int a +type CFW = ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))], [(Id, Node)]) newNode :: CFNode -> CFM Node newNode label = do n <- get + stack <- asks cfTokenStack put (n+1) - tell ([(n, label)], [], []) + tell ([(n, label)], [], [], map (\c -> (c, n)) stack) return n newNodeRange :: CFNode -> CFM Range @@ -367,16 +382,19 @@ withFunctionScope p = do body <- local (\c -> c { cfReturnTarget = Just end, cfIsFunction = True }) p linkRanges [body, nodeToRange end] +-- Anything that happens recursively in f will be attributed to this id +under :: Id -> CFM a -> CFM a +under id f = local (\c -> c { cfTokenStack = id:(cfTokenStack c) }) f nodeToRange :: Node -> Range nodeToRange n = Range n n link :: Node -> Node -> CFEdge -> CFM () link from to label = do - tell ([], [(from, to, label)], []) + tell ([], [(from, to, label)], [], []) registerNode :: Id -> Range -> CFM () -registerNode id (Range start end) = tell ([], [], [(id, (start, end))]) +registerNode id (Range start end) = tell ([], [], [(id, (start, end))], []) linkRange :: Range -> Range -> CFM Range linkRange = linkRangeAs CFEFlow @@ -412,7 +430,7 @@ asCondition = withContext (\c -> c { cfIsCondition = True }) newStructuralNode = newNodeRange CFStructuralNode buildRoot :: Token -> CFM Range -buildRoot t = do +buildRoot t = under (getId t) $ do entry <- newNodeRange $ CFEntryPoint "MAIN" impliedExit <- newNode CFImpliedExit end <- newNode CFStructuralNode @@ -426,7 +444,7 @@ applySingle e = CFApplyEffects [e] -- Build the CFG. build :: Token -> CFM Range build t = do - range <- build' t + range <- under (getId t) $ build' t registerNode (getId t) range return range where diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 0007a67..daade43 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -97,7 +97,8 @@ logInfo log = do -- The result of the data flow analysis data CFGAnalysis = CFGAnalysis { graph :: CFGraph, - tokenToNode :: M.Map Id (Node, Node), + tokenToRange :: M.Map Id (Node, Node), + tokenToNodes :: M.Map Id (S.Set Node), nodeToData :: M.Map Node (ProgramState, ProgramState) } deriving (Show, Generic, NFData) @@ -111,13 +112,13 @@ data ProgramState = ProgramState { -- Conveniently get the state before a token id getIncomingState :: CFGAnalysis -> Id -> Maybe ProgramState getIncomingState analysis id = do - (start,end) <- M.lookup id $ tokenToNode analysis + (start,end) <- M.lookup id $ tokenToRange analysis fst <$> M.lookup start (nodeToData analysis) -- Conveniently get the state after a token id getOutgoingState :: CFGAnalysis -> Id -> Maybe ProgramState getOutgoingState analysis id = do - (start,end) <- M.lookup id $ tokenToNode analysis + (start,end) <- M.lookup id $ tokenToRange analysis snd <$> M.lookup end (nodeToData analysis) getDataForNode analysis node = M.lookup node $ nodeToData analysis @@ -1216,7 +1217,7 @@ analyzeControlFlow :: CFGParameters -> Token -> CFGAnalysis analyzeControlFlow params t = let cfg = buildGraph params t - (entry, exit) = M.findWithDefault (error $ pleaseReport "Missing root") (getId t) (cfIdToNode cfg) + (entry, exit) = M.findWithDefault (error $ pleaseReport "Missing root") (getId t) (cfIdToRange cfg) in runST $ f cfg entry exit where @@ -1250,7 +1251,8 @@ analyzeControlFlow params t = return $ nodeToData `deepseq` CFGAnalysis { graph = cfGraph cfg, - tokenToNode = cfIdToNode cfg, + tokenToRange = cfIdToRange cfg, + tokenToNodes = cfIdToNodes cfg, nodeToData = nodeToData } diff --git a/src/ShellCheck/Debug.hs b/src/ShellCheck/Debug.hs index c991308..b6015e5 100644 --- a/src/ShellCheck/Debug.hs +++ b/src/ShellCheck/Debug.hs @@ -202,7 +202,7 @@ stringToDetailedCfgViz scriptString = cfgToGraphVizWith nodeLabel graph idToToken = M.fromList $ execWriter $ doAnalysis (\c -> tell [(getId c, c)]) ast idToNode :: M.Map Id (Node, Node) - idToNode = cfIdToNode cfgResult + idToNode = cfIdToRange cfgResult nodeToStartIds :: M.Map Node (S.Set Id) nodeToStartIds = From 95b3cbf0714df47feba9ff8d465c27cb6503f38f Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 22 Jul 2022 11:11:09 -0700 Subject: [PATCH 029/244] Qualify Data.Map as M instead of tedious Map --- src/ShellCheck/Checks/Commands.hs | 42 +++++++++++++++---------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index cac06bc..081ec5f 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -39,7 +39,7 @@ import Data.Char import Data.Functor.Identity import Data.List import Data.Maybe -import qualified Data.Map.Strict as Map +import qualified Data.Map.Strict as M import Test.QuickCheck.All (forAllProperties) import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess) @@ -114,7 +114,7 @@ optionalCommandChecks = [ cdNegative = "command -v javac" }, checkWhich) ] -optionalCheckMap = Map.fromList $ map (\(desc, check) -> (cdName desc, check)) optionalCommandChecks +optionalCheckMap = M.fromList $ map (\(desc, check) -> (cdName desc, check)) optionalCommandChecks prop_verifyOptionalExamples = all check optionalCommandChecks where @@ -163,27 +163,27 @@ prop_checkGenericOptsT1 = checkGetOpts "-x -- -y" ["x"] ["-y"] $ return . getGen prop_checkGenericOptsT2 = checkGetOpts "-xy --" ["x", "y"] [] $ return . getGenericOpts -buildCommandMap :: [CommandCheck] -> Map.Map CommandName (Token -> Analysis) -buildCommandMap = foldl' addCheck Map.empty +buildCommandMap :: [CommandCheck] -> M.Map CommandName (Token -> Analysis) +buildCommandMap = foldl' addCheck M.empty where addCheck map (CommandCheck name function) = - Map.insertWith composeAnalyzers name function map + M.insertWith composeAnalyzers name function map -checkCommand :: Map.Map CommandName (Token -> Analysis) -> Token -> Analysis +checkCommand :: M.Map CommandName (Token -> Analysis) -> Token -> Analysis checkCommand map t@(T_SimpleCommand id cmdPrefix (cmd:rest)) = sequence_ $ do name <- getLiteralString cmd return $ if '/' `elem` name then - Map.findWithDefault nullCheck (Basename $ basename name) map t + M.findWithDefault nullCheck (Basename $ basename name) map t else if name == "builtin" && not (null rest) then let t' = T_SimpleCommand id cmdPrefix rest selectedBuiltin = fromMaybe "" $ getLiteralString . head $ rest - in Map.findWithDefault nullCheck (Exactly selectedBuiltin) map t' + in M.findWithDefault nullCheck (Exactly selectedBuiltin) map t' else do - Map.findWithDefault nullCheck (Exactly name) map t - Map.findWithDefault nullCheck (Basename name) map t + M.findWithDefault nullCheck (Exactly name) map t + M.findWithDefault nullCheck (Basename name) map t where basename = reverse . takeWhile (/= '/') . reverse @@ -205,7 +205,7 @@ checker spec params = getChecker $ commandChecks ++ optionals optionals = if "all" `elem` keys then map snd optionalCommandChecks - else mapMaybe (\x -> Map.lookup x optionalCheckMap) keys + else mapMaybe (\x -> M.lookup x optionalCheckMap) keys prop_checkTr1 = verify checkTr "tr [a-f] [A-F]" prop_checkTr2 = verify checkTr "tr 'a-z' 'A-Z'" @@ -1005,20 +1005,20 @@ checkWhileGetoptsCase = CommandCheck (Exactly "getopts") f check :: Id -> [String] -> Token -> Analysis check optId opts (T_CaseExpression id _ list) = do - unless (Nothing `Map.member` handledMap) $ do - mapM_ (warnUnhandled optId id) $ catMaybes $ Map.keys notHandled + unless (Nothing `M.member` handledMap) $ do + mapM_ (warnUnhandled optId id) $ catMaybes $ M.keys notHandled - unless (any (`Map.member` handledMap) [Just "*",Just "?"]) $ + unless (any (`M.member` handledMap) [Just "*",Just "?"]) $ warn id 2220 "Invalid flags are not handled. Add a *) case." - mapM_ warnRedundant $ Map.toList notRequested + mapM_ warnRedundant $ M.toList notRequested where - handledMap = Map.fromList (concatMap getHandledStrings list) - requestedMap = Map.fromList $ map (\x -> (Just x, ())) opts + handledMap = M.fromList (concatMap getHandledStrings list) + requestedMap = M.fromList $ map (\x -> (Just x, ())) opts - notHandled = Map.difference requestedMap handledMap - notRequested = Map.difference handledMap requestedMap + notHandled = M.difference requestedMap handledMap + notRequested = M.difference handledMap requestedMap warnUnhandled optId caseId str = warn caseId 2213 $ "getopts specified -" ++ (e4m str) ++ ", but it's not handled by this 'case'." @@ -1372,10 +1372,10 @@ checkUnquotedEchoSpaces = CommandCheck (Basename "echo") check m <- asks tokenPositions redir <- getClosestCommandM t sequence_ $ do - let positions = mapMaybe (\c -> Map.lookup (getId c) m) args + let positions = mapMaybe (\c -> M.lookup (getId c) m) args let pairs = zip positions (drop 1 positions) (T_Redirecting _ redirTokens _) <- redir - let redirPositions = mapMaybe (\c -> fst <$> Map.lookup (getId c) m) redirTokens + let redirPositions = mapMaybe (\c -> fst <$> M.lookup (getId c) m) redirTokens guard $ any (hasSpacesBetween redirPositions) pairs return $ info (getId t) 2291 "Quote repeated spaces to avoid them collapsing into one." From 9caeec104b5b70054c1b4238d4dfde4c641ea12e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 22 Jul 2022 11:25:07 -0700 Subject: [PATCH 030/244] SC2318: Warn about backreferencing in `declare x=1 y=$x` (fixes #1653) --- CHANGELOG.md | 1 + src/ShellCheck/Checks/Commands.hs | 53 +++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7da6077..dce3e27 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ ### Added - SC2316: Warn about 'local readonly foo' and similar (thanks, patrickxia!) - SC2317: Warn about unreachable commands +- SC2318: Warn about backreferences in 'declare x=1 y=$x' ### Fixed - SC2086: Now uses DFA to make more accurate predictions about values diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 081ec5f..acbf967 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -27,6 +27,8 @@ module ShellCheck.Checks.Commands (checker, optionalChecks, ShellCheck.Checks.Co import ShellCheck.AST import ShellCheck.ASTLib import ShellCheck.AnalyzerLib +import ShellCheck.CFG +import qualified ShellCheck.CFGAnalysis as CF import ShellCheck.Data import ShellCheck.Interface import ShellCheck.Parser @@ -37,12 +39,16 @@ import Control.Monad import Control.Monad.RWS import Data.Char import Data.Functor.Identity +import qualified Data.Graph.Inductive.Graph as G import Data.List import Data.Maybe import qualified Data.Map.Strict as M +import qualified Data.Set as S import Test.QuickCheck.All (forAllProperties) import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess) +import Debug.Trace -- STRIP + data CommandName = Exactly String | Basename String deriving (Eq, Ord) @@ -102,6 +108,7 @@ commandChecks = [ ++ map checkArgComparison ("alias" : declaringCommands) ++ map checkMaskedReturns declaringCommands ++ map checkMultipleDeclaring declaringCommands + ++ map checkBackreferencingDeclaration declaringCommands optionalChecks = map fst optionalCommandChecks @@ -1405,5 +1412,51 @@ checkEvalArray = CommandCheck (Exactly "eval") (mapM_ check . concatMap getWordP _ -> False +prop_checkBackreferencingDeclaration1 = verify (checkBackreferencingDeclaration "declare") "declare x=1 y=foo$x" +prop_checkBackreferencingDeclaration2 = verify (checkBackreferencingDeclaration "readonly") "readonly x=1 y=$((1+x))" +prop_checkBackreferencingDeclaration3 = verify (checkBackreferencingDeclaration "local") "local x=1 y=$(echo $x)" +prop_checkBackreferencingDeclaration4 = verify (checkBackreferencingDeclaration "local") "local x=1 y[$x]=z" +prop_checkBackreferencingDeclaration5 = verify (checkBackreferencingDeclaration "declare") "declare x=var $x=1" +prop_checkBackreferencingDeclaration6 = verify (checkBackreferencingDeclaration "declare") "declare x=var $x=1" +prop_checkBackreferencingDeclaration7 = verify (checkBackreferencingDeclaration "declare") "declare x=var $k=$x" +checkBackreferencingDeclaration cmd = CommandCheck (Exactly cmd) check + where + check t = foldM_ perArg M.empty $ arguments t + + perArg leftArgs t = + case t of + T_Assignment id _ name idx t -> do + warnIfBackreferencing leftArgs $ t:idx + return $ M.insert name id leftArgs + t -> do + warnIfBackreferencing leftArgs [t] + return leftArgs + + warnIfBackreferencing backrefs l = do + references <- findReferences l + let reused = M.intersection backrefs references + mapM msg $ M.toList reused + + msg (name, id) = warn id 2318 $ "This assignment is used again in this '" ++ cmd ++ "', but won't have taken effect. Use two '" ++ cmd ++ "'s." + + findReferences list = do + cfga <- asks cfgAnalysis + let graph = CF.graph cfga + let nodesMap = CF.tokenToNodes cfga + let nodes = S.unions $ map (\id -> M.findWithDefault S.empty id nodesMap) $ map getId $ list + let labels = mapMaybe (G.lab graph) $ S.toList nodes + let references = M.fromList $ concatMap refFromLabel labels + return references + + refFromLabel lab = + case lab of + CFApplyEffects effects -> mapMaybe refFromEffect effects + _ -> [] + refFromEffect e = + case e of + IdTagged id (CFReadVariable name) -> return (name, id) + _ -> Nothing + + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) From e47480e93af07a7e72ee0eb8c0d7d57c92ec35e4 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 22 Jul 2022 16:28:24 -0700 Subject: [PATCH 031/244] Also emit SC2004 for array indices (fixes #1666) --- src/ShellCheck/Analytics.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index ca918ba..8b8d489 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1460,7 +1460,8 @@ prop_checkArithmeticDeref7 = verifyNot checkArithmeticDeref "(( 10#$n ))" prop_checkArithmeticDeref8 = verifyNot checkArithmeticDeref "let i=$i+1" prop_checkArithmeticDeref9 = verifyNot checkArithmeticDeref "(( a[foo] ))" prop_checkArithmeticDeref10= verifyNot checkArithmeticDeref "(( a[\\$foo] ))" -prop_checkArithmeticDeref11= verifyNot checkArithmeticDeref "a[$foo]=wee" +prop_checkArithmeticDeref11= verify checkArithmeticDeref "a[$foo]=wee" +prop_checkArithmeticDeref11b= verifyNot checkArithmeticDeref "declare -A a; a[$foo]=wee" prop_checkArithmeticDeref12= verify checkArithmeticDeref "for ((i=0; $i < 3; i)); do true; done" prop_checkArithmeticDeref13= verifyNot checkArithmeticDeref "(( $$ ))" prop_checkArithmeticDeref14= verifyNot checkArithmeticDeref "(( $! ))" @@ -1477,6 +1478,7 @@ checkArithmeticDeref params t@(TA_Expansion _ [T_DollarBraced id _ l]) = T_Arithmetic {} -> return normalWarning T_DollarArithmetic {} -> return normalWarning T_ForArithmetic {} -> return normalWarning + T_Assignment {} -> return normalWarning T_SimpleCommand {} -> return noWarning _ -> Nothing From 2f28847b0897a8f91c6f227ed098470eea383dd4 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 22 Jul 2022 16:35:14 -0700 Subject: [PATCH 032/244] Normalize spaces around = in unit tests --- src/ShellCheck/ASTLib.hs | 10 +- src/ShellCheck/Analytics.hs | 392 +++++++++++++------------- src/ShellCheck/Checks/Commands.hs | 76 ++--- src/ShellCheck/Checks/ShellSupport.hs | 106 +++---- src/ShellCheck/Parser.hs | 90 +++--- 5 files changed, 337 insertions(+), 337 deletions(-) diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 7cc5af2..7b4f9e5 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -810,11 +810,11 @@ prop_getBracedReference6 = getBracedReference "!#" == "#" prop_getBracedReference7 = getBracedReference "!foo#?" == "foo" prop_getBracedReference8 = getBracedReference "foo-bar" == "foo" prop_getBracedReference9 = getBracedReference "foo:-bar" == "foo" -prop_getBracedReference10= getBracedReference "foo: -1" == "foo" -prop_getBracedReference11= getBracedReference "!os*" == "" -prop_getBracedReference11b= getBracedReference "!os@" == "" -prop_getBracedReference12= getBracedReference "!os?bar**" == "" -prop_getBracedReference13= getBracedReference "foo[bar]" == "foo" +prop_getBracedReference10 = getBracedReference "foo: -1" == "foo" +prop_getBracedReference11 = getBracedReference "!os*" == "" +prop_getBracedReference11b = getBracedReference "!os@" == "" +prop_getBracedReference12 = getBracedReference "!os?bar**" == "" +prop_getBracedReference13 = getBracedReference "foo[bar]" == "foo" getBracedReference s = fromMaybe s $ nameExpansion s `mplus` takeName noPrefix `mplus` getSpecial noPrefix `mplus` getSpecial s where diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 8b8d489..1429e1b 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -638,15 +638,15 @@ prop_checkShebang6 = verifyNotTree checkShebang "#!/usr/bin/env ash\n# shellchec prop_checkShebang7 = verifyNotTree checkShebang "#!/usr/bin/env ash\n# shellcheck shell=sh\n" prop_checkShebang8 = verifyTree checkShebang "#!bin/sh\ntrue" prop_checkShebang9 = verifyNotTree checkShebang "# shellcheck shell=sh\ntrue" -prop_checkShebang10= verifyNotTree checkShebang "#!foo\n# shellcheck shell=sh ignore=SC2239\ntrue" -prop_checkShebang11= verifyTree checkShebang "#!/bin/sh/\ntrue" -prop_checkShebang12= verifyTree checkShebang "#!/bin/sh/ -xe\ntrue" -prop_checkShebang13= verifyTree checkShebang "#!/bin/busybox sh" -prop_checkShebang14= verifyNotTree checkShebang "#!/bin/busybox sh\n# shellcheck shell=sh\n" -prop_checkShebang15= verifyNotTree checkShebang "#!/bin/busybox sh\n# shellcheck shell=dash\n" -prop_checkShebang16= verifyTree checkShebang "#!/bin/busybox ash" -prop_checkShebang17= verifyNotTree checkShebang "#!/bin/busybox ash\n# shellcheck shell=dash\n" -prop_checkShebang18= verifyNotTree checkShebang "#!/bin/busybox ash\n# shellcheck shell=sh\n" +prop_checkShebang10 = verifyNotTree checkShebang "#!foo\n# shellcheck shell=sh ignore=SC2239\ntrue" +prop_checkShebang11 = verifyTree checkShebang "#!/bin/sh/\ntrue" +prop_checkShebang12 = verifyTree checkShebang "#!/bin/sh/ -xe\ntrue" +prop_checkShebang13 = verifyTree checkShebang "#!/bin/busybox sh" +prop_checkShebang14 = verifyNotTree checkShebang "#!/bin/busybox sh\n# shellcheck shell=sh\n" +prop_checkShebang15 = verifyNotTree checkShebang "#!/bin/busybox sh\n# shellcheck shell=dash\n" +prop_checkShebang16 = verifyTree checkShebang "#!/bin/busybox ash" +prop_checkShebang17 = verifyNotTree checkShebang "#!/bin/busybox ash\n# shellcheck shell=dash\n" +prop_checkShebang18 = verifyNotTree checkShebang "#!/bin/busybox ash\n# shellcheck shell=sh\n" checkShebang params (T_Annotation _ list t) = if any isOverride list then [] else checkShebang params t where @@ -700,9 +700,9 @@ checkForInQuoted params (T_ForIn _ _ multiple _) = checkForInQuoted _ _ = return () prop_checkForInCat1 = verify checkForInCat "for f in $(cat foo); do stuff; done" -prop_checkForInCat1a= verify checkForInCat "for f in `cat foo`; do stuff; done" +prop_checkForInCat1a = verify checkForInCat "for f in `cat foo`; do stuff; done" prop_checkForInCat2 = verify checkForInCat "for f in $(cat foo | grep lol); do stuff; done" -prop_checkForInCat2a= verify checkForInCat "for f in `cat foo | grep lol`; do stuff; done" +prop_checkForInCat2a = verify checkForInCat "for f in `cat foo | grep lol`; do stuff; done" prop_checkForInCat3 = verifyNot checkForInCat "for f in $(cat foo | grep bar | wc -l); do stuff; done" checkForInCat _ (T_ForIn _ f [T_NormalWord _ w] _) = mapM_ checkF w where @@ -775,10 +775,10 @@ checkFindExec _ _ = return () prop_checkUnquotedExpansions1 = verify checkUnquotedExpansions "rm $(ls)" -prop_checkUnquotedExpansions1a= verify checkUnquotedExpansions "rm `ls`" +prop_checkUnquotedExpansions1a = verify checkUnquotedExpansions "rm `ls`" prop_checkUnquotedExpansions2 = verify checkUnquotedExpansions "rm foo$(date)" prop_checkUnquotedExpansions3 = verify checkUnquotedExpansions "[ $(foo) == cow ]" -prop_checkUnquotedExpansions3a= verify checkUnquotedExpansions "[ ! $(foo) ]" +prop_checkUnquotedExpansions3a = verify checkUnquotedExpansions "[ ! $(foo) ]" prop_checkUnquotedExpansions4 = verifyNot checkUnquotedExpansions "[[ $(foo) == cow ]]" prop_checkUnquotedExpansions5 = verifyNot checkUnquotedExpansions "for f in $(cmd); do echo $f; done" prop_checkUnquotedExpansions6 = verifyNot checkUnquotedExpansions "$(cmd)" @@ -906,7 +906,7 @@ checkDollarStar _ _ = return () prop_checkUnquotedDollarAt = verify checkUnquotedDollarAt "ls $@" -prop_checkUnquotedDollarAt1= verifyNot checkUnquotedDollarAt "ls ${#@}" +prop_checkUnquotedDollarAt1 = verifyNot checkUnquotedDollarAt "ls ${#@}" prop_checkUnquotedDollarAt2 = verify checkUnquotedDollarAt "ls ${foo[@]}" prop_checkUnquotedDollarAt3 = verifyNot checkUnquotedDollarAt "ls ${#foo[@]}" prop_checkUnquotedDollarAt4 = verifyNot checkUnquotedDollarAt "ls \"$@\"" @@ -1037,32 +1037,32 @@ ltt t = trace ("Tracing " ++ show t) -- STRIP prop_checkSingleQuotedVariables = verify checkSingleQuotedVariables "echo '$foo'" prop_checkSingleQuotedVariables2 = verify checkSingleQuotedVariables "echo 'lol$1.jpg'" prop_checkSingleQuotedVariables3 = verifyNot checkSingleQuotedVariables "sed 's/foo$/bar/'" -prop_checkSingleQuotedVariables3a= verify checkSingleQuotedVariables "sed 's/${foo}/bar/'" -prop_checkSingleQuotedVariables3b= verify checkSingleQuotedVariables "sed 's/$(echo cow)/bar/'" -prop_checkSingleQuotedVariables3c= verify checkSingleQuotedVariables "sed 's/$((1+foo))/bar/'" +prop_checkSingleQuotedVariables3a = verify checkSingleQuotedVariables "sed 's/${foo}/bar/'" +prop_checkSingleQuotedVariables3b = verify checkSingleQuotedVariables "sed 's/$(echo cow)/bar/'" +prop_checkSingleQuotedVariables3c = verify checkSingleQuotedVariables "sed 's/$((1+foo))/bar/'" prop_checkSingleQuotedVariables4 = verifyNot checkSingleQuotedVariables "awk '{print $1}'" prop_checkSingleQuotedVariables5 = verifyNot checkSingleQuotedVariables "trap 'echo $SECONDS' EXIT" prop_checkSingleQuotedVariables6 = verifyNot checkSingleQuotedVariables "sed -n '$p'" -prop_checkSingleQuotedVariables6a= verify checkSingleQuotedVariables "sed -n '$pattern'" +prop_checkSingleQuotedVariables6a = verify checkSingleQuotedVariables "sed -n '$pattern'" prop_checkSingleQuotedVariables7 = verifyNot checkSingleQuotedVariables "PS1='$PWD \\$ '" prop_checkSingleQuotedVariables8 = verify checkSingleQuotedVariables "find . -exec echo '$1' {} +" prop_checkSingleQuotedVariables9 = verifyNot checkSingleQuotedVariables "find . -exec awk '{print $1}' {} \\;" -prop_checkSingleQuotedVariables10= verify checkSingleQuotedVariables "echo '`pwd`'" -prop_checkSingleQuotedVariables11= verifyNot checkSingleQuotedVariables "sed '${/lol/d}'" -prop_checkSingleQuotedVariables12= verifyNot checkSingleQuotedVariables "eval 'echo $1'" -prop_checkSingleQuotedVariables13= verifyNot checkSingleQuotedVariables "busybox awk '{print $1}'" -prop_checkSingleQuotedVariables14= verifyNot checkSingleQuotedVariables "[ -v 'bar[$foo]' ]" -prop_checkSingleQuotedVariables15= verifyNot checkSingleQuotedVariables "git filter-branch 'test $GIT_COMMIT'" -prop_checkSingleQuotedVariables16= verify checkSingleQuotedVariables "git '$a'" -prop_checkSingleQuotedVariables17= verifyNot checkSingleQuotedVariables "rename 's/(.)a/$1/g' *" -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__'" +prop_checkSingleQuotedVariables10 = verify checkSingleQuotedVariables "echo '`pwd`'" +prop_checkSingleQuotedVariables11 = verifyNot checkSingleQuotedVariables "sed '${/lol/d}'" +prop_checkSingleQuotedVariables12 = verifyNot checkSingleQuotedVariables "eval 'echo $1'" +prop_checkSingleQuotedVariables13 = verifyNot checkSingleQuotedVariables "busybox awk '{print $1}'" +prop_checkSingleQuotedVariables14 = verifyNot checkSingleQuotedVariables "[ -v 'bar[$foo]' ]" +prop_checkSingleQuotedVariables15 = verifyNot checkSingleQuotedVariables "git filter-branch 'test $GIT_COMMIT'" +prop_checkSingleQuotedVariables16 = verify checkSingleQuotedVariables "git '$a'" +prop_checkSingleQuotedVariables17 = verifyNot checkSingleQuotedVariables "rename 's/(.)a/$1/g' *" +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) = @@ -1353,8 +1353,8 @@ checkGlobbedRegex _ _ = return () prop_checkConstantIfs1 = verify checkConstantIfs "[[ foo != bar ]]" -prop_checkConstantIfs2a= verify checkConstantIfs "[ n -le 4 ]" -prop_checkConstantIfs2b= verifyNot checkConstantIfs "[[ n -le 4 ]]" +prop_checkConstantIfs2a = verify checkConstantIfs "[ n -le 4 ]" +prop_checkConstantIfs2b = verifyNot checkConstantIfs "[[ n -le 4 ]]" prop_checkConstantIfs3 = verify checkConstantIfs "[[ $n -le 4 && n != 2 ]]" prop_checkConstantIfs4 = verifyNot checkConstantIfs "[[ $n -le 3 ]]" prop_checkConstantIfs5 = verifyNot checkConstantIfs "[[ $n -le $n ]]" @@ -1459,14 +1459,14 @@ prop_checkArithmeticDeref6 = verify checkArithmeticDeref "(( a[$i] ))" prop_checkArithmeticDeref7 = verifyNot checkArithmeticDeref "(( 10#$n ))" prop_checkArithmeticDeref8 = verifyNot checkArithmeticDeref "let i=$i+1" prop_checkArithmeticDeref9 = verifyNot checkArithmeticDeref "(( a[foo] ))" -prop_checkArithmeticDeref10= verifyNot checkArithmeticDeref "(( a[\\$foo] ))" -prop_checkArithmeticDeref11= verify checkArithmeticDeref "a[$foo]=wee" -prop_checkArithmeticDeref11b= verifyNot checkArithmeticDeref "declare -A a; a[$foo]=wee" -prop_checkArithmeticDeref12= verify checkArithmeticDeref "for ((i=0; $i < 3; i)); do true; done" -prop_checkArithmeticDeref13= verifyNot checkArithmeticDeref "(( $$ ))" -prop_checkArithmeticDeref14= verifyNot checkArithmeticDeref "(( $! ))" -prop_checkArithmeticDeref15= verifyNot checkArithmeticDeref "(( ${!var} ))" -prop_checkArithmeticDeref16= verifyNot checkArithmeticDeref "(( ${x+1} + ${x=42} ))" +prop_checkArithmeticDeref10 = verifyNot checkArithmeticDeref "(( a[\\$foo] ))" +prop_checkArithmeticDeref11 = verify checkArithmeticDeref "a[$foo]=wee" +prop_checkArithmeticDeref11b = verifyNot checkArithmeticDeref "declare -A a; a[$foo]=wee" +prop_checkArithmeticDeref12 = verify checkArithmeticDeref "for ((i=0; $i < 3; i)); do true; done" +prop_checkArithmeticDeref13 = verifyNot checkArithmeticDeref "(( $$ ))" +prop_checkArithmeticDeref14 = verifyNot checkArithmeticDeref "(( $! ))" +prop_checkArithmeticDeref15 = verifyNot checkArithmeticDeref "(( ${!var} ))" +prop_checkArithmeticDeref16 = verifyNot checkArithmeticDeref "(( ${x+1} + ${x=42} ))" checkArithmeticDeref params t@(TA_Expansion _ [T_DollarBraced id _ l]) = unless (isException $ concat $ oversimplify l) getWarning where @@ -1602,7 +1602,7 @@ checkOrNeq _ _ = return () prop_checkValidCondOps1 = verify checkValidCondOps "[[ a -xz b ]]" prop_checkValidCondOps2 = verify checkValidCondOps "[ -M a ]" -prop_checkValidCondOps2a= verifyNot checkValidCondOps "[ 3 \\> 2 ]" +prop_checkValidCondOps2a = verifyNot checkValidCondOps "[ 3 \\> 2 ]" prop_checkValidCondOps3 = verifyNot checkValidCondOps "[ 1 = 2 -a 3 -ge 4 ]" prop_checkValidCondOps4 = verifyNot checkValidCondOps "[[ ! -v foo ]]" checkValidCondOps _ (TC_Binary id _ s _ _) @@ -1670,11 +1670,11 @@ checkTestRedirects _ (T_Redirecting id redirs cmd) | cmd `isCommand` "test" = checkTestRedirects _ _ = return () prop_checkPS11 = verify checkPS1Assignments "PS1='\\033[1;35m\\$ '" -prop_checkPS11a= verify checkPS1Assignments "export PS1='\\033[1;35m\\$ '" +prop_checkPS11a = verify checkPS1Assignments "export PS1='\\033[1;35m\\$ '" prop_checkPSf2 = verify checkPS1Assignments "PS1='\\h \\e[0m\\$ '" prop_checkPS13 = verify checkPS1Assignments "PS1=$'\\x1b[c '" prop_checkPS14 = verify checkPS1Assignments "PS1=$'\\e[3m; '" -prop_checkPS14a= verify checkPS1Assignments "export PS1=$'\\e[3m; '" +prop_checkPS14a = verify checkPS1Assignments "export PS1=$'\\e[3m; '" prop_checkPS15 = verifyNot checkPS1Assignments "PS1='\\[\\033[1;35m\\]\\$ '" prop_checkPS16 = verifyNot checkPS1Assignments "PS1='\\[\\e1m\\e[1m\\]\\$ '" prop_checkPS17 = verifyNot checkPS1Assignments "PS1='e033x1B'" @@ -1943,7 +1943,7 @@ prop_subshellAssignmentCheck3 = verifyTree subshellAssignmentCheck "( A=foo; prop_subshellAssignmentCheck4 = verifyNotTree subshellAssignmentCheck "( A=foo; rm $A; )" prop_subshellAssignmentCheck5 = verifyTree subshellAssignmentCheck "cat foo | while read cow; do true; done; echo $cow;" prop_subshellAssignmentCheck6 = verifyTree subshellAssignmentCheck "( export lol=$(ls); ); echo $lol;" -prop_subshellAssignmentCheck6a= verifyTree subshellAssignmentCheck "( typeset -a lol=a; ); echo $lol;" +prop_subshellAssignmentCheck6a = verifyTree subshellAssignmentCheck "( typeset -a lol=a; ); echo $lol;" prop_subshellAssignmentCheck7 = verifyTree subshellAssignmentCheck "cmd | while read foo; do (( n++ )); done; echo \"$n lines\"" prop_subshellAssignmentCheck8 = verifyTree subshellAssignmentCheck "n=3 & echo $((n++))" prop_subshellAssignmentCheck9 = verifyTree subshellAssignmentCheck "read n & n=foo$n" @@ -2027,67 +2027,67 @@ prop_checkSpacefulnessCfg1 = verify checkSpacefulnessCfg "a='cow moo'; echo $a" prop_checkSpacefulnessCfg2 = verifyNot checkSpacefulnessCfg "a='cow moo'; [[ $a ]]" prop_checkSpacefulnessCfg3 = verifyNot checkSpacefulnessCfg "a='cow*.mp3'; echo \"$a\"" prop_checkSpacefulnessCfg4 = verify checkSpacefulnessCfg "for f in *.mp3; do echo $f; done" -prop_checkSpacefulnessCfg4a= verifyNot checkSpacefulnessCfg "foo=3; foo=$(echo $foo)" +prop_checkSpacefulnessCfg4a = verifyNot checkSpacefulnessCfg "foo=3; foo=$(echo $foo)" prop_checkSpacefulnessCfg5 = verify checkSpacefulnessCfg "a='*'; b=$a; c=lol${b//foo/bar}; echo $c" prop_checkSpacefulnessCfg6 = verify checkSpacefulnessCfg "a=foo$(lol); echo $a" prop_checkSpacefulnessCfg7 = verify checkSpacefulnessCfg "a=foo\\ bar; rm $a" prop_checkSpacefulnessCfg8 = verifyNot checkSpacefulnessCfg "a=foo\\ bar; a=foo; rm $a" -prop_checkSpacefulnessCfg10= verify checkSpacefulnessCfg "rm $1" -prop_checkSpacefulnessCfg11= verify checkSpacefulnessCfg "rm ${10//foo/bar}" -prop_checkSpacefulnessCfg12= verifyNot checkSpacefulnessCfg "(( $1 + 3 ))" -prop_checkSpacefulnessCfg13= verifyNot checkSpacefulnessCfg "if [[ $2 -gt 14 ]]; then true; fi" -prop_checkSpacefulnessCfg14= verifyNot checkSpacefulnessCfg "foo=$3 env" -prop_checkSpacefulnessCfg15= verifyNot checkSpacefulnessCfg "local foo=$1" -prop_checkSpacefulnessCfg16= verifyNot checkSpacefulnessCfg "declare foo=$1" -prop_checkSpacefulnessCfg17= verify checkSpacefulnessCfg "echo foo=$1" -prop_checkSpacefulnessCfg18= verifyNot checkSpacefulnessCfg "$1 --flags" -prop_checkSpacefulnessCfg19= verify checkSpacefulnessCfg "echo $PWD" -prop_checkSpacefulnessCfg20= verifyNot checkSpacefulnessCfg "n+='foo bar'" -prop_checkSpacefulnessCfg21= verifyNot checkSpacefulnessCfg "select foo in $bar; do true; done" -prop_checkSpacefulnessCfg22= verifyNot checkSpacefulnessCfg "echo $\"$1\"" -prop_checkSpacefulnessCfg23= verifyNot checkSpacefulnessCfg "a=(1); echo ${a[@]}" -prop_checkSpacefulnessCfg24= verify checkSpacefulnessCfg "a='a b'; cat <<< $a" -prop_checkSpacefulnessCfg25= verify checkSpacefulnessCfg "a='s/[0-9]//g'; sed $a" -prop_checkSpacefulnessCfg26= verify checkSpacefulnessCfg "a='foo bar'; echo {1,2,$a}" -prop_checkSpacefulnessCfg27= verifyNot checkSpacefulnessCfg "echo ${a:+'foo'}" -prop_checkSpacefulnessCfg28= verifyNot checkSpacefulnessCfg "exec {n}>&1; echo $n" -prop_checkSpacefulnessCfg29= verifyNot checkSpacefulnessCfg "n=$(stuff); exec {n}>&-;" -prop_checkSpacefulnessCfg30= verify checkSpacefulnessCfg "file='foo bar'; echo foo > $file;" -prop_checkSpacefulnessCfg31= verifyNot checkSpacefulnessCfg "echo \"`echo \\\"$1\\\"`\"" -prop_checkSpacefulnessCfg32= verifyNot checkSpacefulnessCfg "var=$1; [ -v var ]" -prop_checkSpacefulnessCfg33= verify checkSpacefulnessCfg "for file; do echo $file; done" -prop_checkSpacefulnessCfg34= verify checkSpacefulnessCfg "declare foo$n=$1" -prop_checkSpacefulnessCfg35= verifyNot checkSpacefulnessCfg "echo ${1+\"$1\"}" -prop_checkSpacefulnessCfg36= verifyNot checkSpacefulnessCfg "arg=$#; echo $arg" -prop_checkSpacefulnessCfg37= verifyNot checkSpacefulnessCfg "@test 'status' {\n [ $status -eq 0 ]\n}" +prop_checkSpacefulnessCfg10 = verify checkSpacefulnessCfg "rm $1" +prop_checkSpacefulnessCfg11 = verify checkSpacefulnessCfg "rm ${10//foo/bar}" +prop_checkSpacefulnessCfg12 = verifyNot checkSpacefulnessCfg "(( $1 + 3 ))" +prop_checkSpacefulnessCfg13 = verifyNot checkSpacefulnessCfg "if [[ $2 -gt 14 ]]; then true; fi" +prop_checkSpacefulnessCfg14 = verifyNot checkSpacefulnessCfg "foo=$3 env" +prop_checkSpacefulnessCfg15 = verifyNot checkSpacefulnessCfg "local foo=$1" +prop_checkSpacefulnessCfg16 = verifyNot checkSpacefulnessCfg "declare foo=$1" +prop_checkSpacefulnessCfg17 = verify checkSpacefulnessCfg "echo foo=$1" +prop_checkSpacefulnessCfg18 = verifyNot checkSpacefulnessCfg "$1 --flags" +prop_checkSpacefulnessCfg19 = verify checkSpacefulnessCfg "echo $PWD" +prop_checkSpacefulnessCfg20 = verifyNot checkSpacefulnessCfg "n+='foo bar'" +prop_checkSpacefulnessCfg21 = verifyNot checkSpacefulnessCfg "select foo in $bar; do true; done" +prop_checkSpacefulnessCfg22 = verifyNot checkSpacefulnessCfg "echo $\"$1\"" +prop_checkSpacefulnessCfg23 = verifyNot checkSpacefulnessCfg "a=(1); echo ${a[@]}" +prop_checkSpacefulnessCfg24 = verify checkSpacefulnessCfg "a='a b'; cat <<< $a" +prop_checkSpacefulnessCfg25 = verify checkSpacefulnessCfg "a='s/[0-9]//g'; sed $a" +prop_checkSpacefulnessCfg26 = verify checkSpacefulnessCfg "a='foo bar'; echo {1,2,$a}" +prop_checkSpacefulnessCfg27 = verifyNot checkSpacefulnessCfg "echo ${a:+'foo'}" +prop_checkSpacefulnessCfg28 = verifyNot checkSpacefulnessCfg "exec {n}>&1; echo $n" +prop_checkSpacefulnessCfg29 = verifyNot checkSpacefulnessCfg "n=$(stuff); exec {n}>&-;" +prop_checkSpacefulnessCfg30 = verify checkSpacefulnessCfg "file='foo bar'; echo foo > $file;" +prop_checkSpacefulnessCfg31 = verifyNot checkSpacefulnessCfg "echo \"`echo \\\"$1\\\"`\"" +prop_checkSpacefulnessCfg32 = verifyNot checkSpacefulnessCfg "var=$1; [ -v var ]" +prop_checkSpacefulnessCfg33 = verify checkSpacefulnessCfg "for file; do echo $file; done" +prop_checkSpacefulnessCfg34 = verify checkSpacefulnessCfg "declare foo$n=$1" +prop_checkSpacefulnessCfg35 = verifyNot checkSpacefulnessCfg "echo ${1+\"$1\"}" +prop_checkSpacefulnessCfg36 = verifyNot checkSpacefulnessCfg "arg=$#; echo $arg" +prop_checkSpacefulnessCfg37 = verifyNot checkSpacefulnessCfg "@test 'status' {\n [ $status -eq 0 ]\n}" prop_checkSpacefulnessCfg37v = verify checkVerboseSpacefulnessCfg "@test 'status' {\n [ $status -eq 0 ]\n}" -prop_checkSpacefulnessCfg38= verify checkSpacefulnessCfg "a=; echo $a" -prop_checkSpacefulnessCfg39= verifyNot checkSpacefulnessCfg "a=''\"\"''; b=x$a; echo $b" -prop_checkSpacefulnessCfg40= verifyNot checkSpacefulnessCfg "a=$((x+1)); echo $a" -prop_checkSpacefulnessCfg41= verifyNot checkSpacefulnessCfg "exec $1 --flags" -prop_checkSpacefulnessCfg42= verifyNot checkSpacefulnessCfg "run $1 --flags" -prop_checkSpacefulnessCfg43= verifyNot checkSpacefulnessCfg "$foo=42" -prop_checkSpacefulnessCfg44= verify checkSpacefulnessCfg "#!/bin/sh\nexport var=$value" -prop_checkSpacefulnessCfg45= verifyNot checkSpacefulnessCfg "wait -zzx -p foo; echo $foo" -prop_checkSpacefulnessCfg46= verifyNot checkSpacefulnessCfg "x=0; (( x += 1 )); echo $x" -prop_checkSpacefulnessCfg47= verifyNot checkSpacefulnessCfg "x=0; (( x-- )); echo $x" -prop_checkSpacefulnessCfg48= verifyNot checkSpacefulnessCfg "x=0; (( ++x )); echo $x" -prop_checkSpacefulnessCfg49= verifyNot checkSpacefulnessCfg "for i in 1 2 3; do echo $i; done" -prop_checkSpacefulnessCfg50= verify checkSpacefulnessCfg "for i in 1 2 *; do echo $i; done" -prop_checkSpacefulnessCfg51= verify checkSpacefulnessCfg "x='foo bar'; x && x=1; echo $x" -prop_checkSpacefulnessCfg52= verifyNot checkSpacefulnessCfg "x=1; if f; then x='foo bar'; exit; fi; echo $x" -prop_checkSpacefulnessCfg53= verifyNot checkSpacefulnessCfg "s=1; f() { local s='a b'; }; f; echo $s" -prop_checkSpacefulnessCfg54= verifyNot checkSpacefulnessCfg "s='a b'; f() { s=1; }; f; echo $s" -prop_checkSpacefulnessCfg55= verify checkSpacefulnessCfg "s='a b'; x && f() { s=1; }; f; echo $s" -prop_checkSpacefulnessCfg56= verifyNot checkSpacefulnessCfg "s=1; cat <(s='a b'); echo $s" -prop_checkSpacefulnessCfg57= verifyNot checkSpacefulnessCfg "declare -i s=0; s=$(f); echo $s" -prop_checkSpacefulnessCfg58= verify checkSpacefulnessCfg "f() { declare -i s; }; f; s=$(var); echo $s" -prop_checkSpacefulnessCfg59= verifyNot checkSpacefulnessCfg "f() { declare -gi s; }; f; s=$(var); echo $s" -prop_checkSpacefulnessCfg60= verify checkSpacefulnessCfg "declare -i s; declare +i s; s=$(foo); echo $s" -prop_checkSpacefulnessCfg61= verify checkSpacefulnessCfg "declare -x X; y=foo$X; echo $y;" -prop_checkSpacefulnessCfg62= verifyNot checkSpacefulnessCfg "f() { declare -x X; y=foo$X; echo $y; }" -prop_checkSpacefulnessCfg63= verify checkSpacefulnessCfg "f && declare -i s; s='x + y'; echo $s" -prop_checkSpacefulnessCfg64= verifyNot checkSpacefulnessCfg "declare -i s; s='x + y'; x=$s; echo $x" +prop_checkSpacefulnessCfg38 = verify checkSpacefulnessCfg "a=; echo $a" +prop_checkSpacefulnessCfg39 = verifyNot checkSpacefulnessCfg "a=''\"\"''; b=x$a; echo $b" +prop_checkSpacefulnessCfg40 = verifyNot checkSpacefulnessCfg "a=$((x+1)); echo $a" +prop_checkSpacefulnessCfg41 = verifyNot checkSpacefulnessCfg "exec $1 --flags" +prop_checkSpacefulnessCfg42 = verifyNot checkSpacefulnessCfg "run $1 --flags" +prop_checkSpacefulnessCfg43 = verifyNot checkSpacefulnessCfg "$foo=42" +prop_checkSpacefulnessCfg44 = verify checkSpacefulnessCfg "#!/bin/sh\nexport var=$value" +prop_checkSpacefulnessCfg45 = verifyNot checkSpacefulnessCfg "wait -zzx -p foo; echo $foo" +prop_checkSpacefulnessCfg46 = verifyNot checkSpacefulnessCfg "x=0; (( x += 1 )); echo $x" +prop_checkSpacefulnessCfg47 = verifyNot checkSpacefulnessCfg "x=0; (( x-- )); echo $x" +prop_checkSpacefulnessCfg48 = verifyNot checkSpacefulnessCfg "x=0; (( ++x )); echo $x" +prop_checkSpacefulnessCfg49 = verifyNot checkSpacefulnessCfg "for i in 1 2 3; do echo $i; done" +prop_checkSpacefulnessCfg50 = verify checkSpacefulnessCfg "for i in 1 2 *; do echo $i; done" +prop_checkSpacefulnessCfg51 = verify checkSpacefulnessCfg "x='foo bar'; x && x=1; echo $x" +prop_checkSpacefulnessCfg52 = verifyNot checkSpacefulnessCfg "x=1; if f; then x='foo bar'; exit; fi; echo $x" +prop_checkSpacefulnessCfg53 = verifyNot checkSpacefulnessCfg "s=1; f() { local s='a b'; }; f; echo $s" +prop_checkSpacefulnessCfg54 = verifyNot checkSpacefulnessCfg "s='a b'; f() { s=1; }; f; echo $s" +prop_checkSpacefulnessCfg55 = verify checkSpacefulnessCfg "s='a b'; x && f() { s=1; }; f; echo $s" +prop_checkSpacefulnessCfg56 = verifyNot checkSpacefulnessCfg "s=1; cat <(s='a b'); echo $s" +prop_checkSpacefulnessCfg57 = verifyNot checkSpacefulnessCfg "declare -i s=0; s=$(f); echo $s" +prop_checkSpacefulnessCfg58 = verify checkSpacefulnessCfg "f() { declare -i s; }; f; s=$(var); echo $s" +prop_checkSpacefulnessCfg59 = verifyNot checkSpacefulnessCfg "f() { declare -gi s; }; f; s=$(var); echo $s" +prop_checkSpacefulnessCfg60 = verify checkSpacefulnessCfg "declare -i s; declare +i s; s=$(foo); echo $s" +prop_checkSpacefulnessCfg61 = verify checkSpacefulnessCfg "declare -x X; y=foo$X; echo $y;" +prop_checkSpacefulnessCfg62 = verifyNot checkSpacefulnessCfg "f() { declare -x X; y=foo$X; echo $y; }" +prop_checkSpacefulnessCfg63 = verify checkSpacefulnessCfg "f && declare -i s; s='x + y'; echo $s" +prop_checkSpacefulnessCfg64 = verifyNot checkSpacefulnessCfg "declare -i s; s='x + y'; x=$s; echo $x" checkSpacefulnessCfg = checkSpacefulnessCfg' True checkVerboseSpacefulnessCfg = checkSpacefulnessCfg' False @@ -2157,13 +2157,13 @@ checkVariableBraces params t@(T_DollarBraced id False l) checkVariableBraces _ _ = return () prop_checkQuotesInLiterals1 = verifyTree checkQuotesInLiterals "param='--foo=\"bar\"'; app $param" -prop_checkQuotesInLiterals1a= verifyTree checkQuotesInLiterals "param=\"--foo='lolbar'\"; app $param" +prop_checkQuotesInLiterals1a = verifyTree checkQuotesInLiterals "param=\"--foo='lolbar'\"; app $param" prop_checkQuotesInLiterals2 = verifyNotTree checkQuotesInLiterals "param='--foo=\"bar\"'; app \"$param\"" prop_checkQuotesInLiterals3 =verifyNotTree checkQuotesInLiterals "param=('--foo='); app \"${param[@]}\"" prop_checkQuotesInLiterals4 = verifyNotTree checkQuotesInLiterals "param=\"don't bother with this one\"; app $param" prop_checkQuotesInLiterals5 = verifyNotTree checkQuotesInLiterals "param=\"--foo='lolbar'\"; eval app $param" prop_checkQuotesInLiterals6 = verifyTree checkQuotesInLiterals "param='my\\ file'; cmd=\"rm $param\"; $cmd" -prop_checkQuotesInLiterals6a= verifyNotTree checkQuotesInLiterals "param='my\\ file'; cmd=\"rm ${#param}\"; $cmd" +prop_checkQuotesInLiterals6a = verifyNotTree checkQuotesInLiterals "param='my\\ file'; cmd=\"rm ${#param}\"; $cmd" prop_checkQuotesInLiterals7 = verifyTree checkQuotesInLiterals "param='my\\ file'; rm $param" prop_checkQuotesInLiterals8 = verifyTree checkQuotesInLiterals "param=\"/foo/'bar baz'/etc\"; rm $param" prop_checkQuotesInLiterals9 = verifyNotTree checkQuotesInLiterals "param=\"/foo/'bar baz'/etc\"; rm ${#param}" @@ -2227,9 +2227,9 @@ prop_checkFunctionsUsedExternally1 = verifyTree checkFunctionsUsedExternally "foo() { :; }; sudo foo" prop_checkFunctionsUsedExternally2 = verifyTree checkFunctionsUsedExternally "alias f='a'; xargs -0 f" -prop_checkFunctionsUsedExternally2b= +prop_checkFunctionsUsedExternally2b = verifyNotTree checkFunctionsUsedExternally "alias f='a'; find . -type f" -prop_checkFunctionsUsedExternally2c= +prop_checkFunctionsUsedExternally2c = verifyTree checkFunctionsUsedExternally "alias f='a'; find . -type f -exec f +" prop_checkFunctionsUsedExternally3 = verifyNotTree checkFunctionsUsedExternally "f() { :; }; echo f" @@ -2305,49 +2305,49 @@ prop_checkUnused6 = verifyNotTree checkUnusedAssignments "var=4; (( var++ ))" prop_checkUnused7 = verifyNotTree checkUnusedAssignments "var=2; $((var))" prop_checkUnused8 = verifyTree checkUnusedAssignments "var=2; var=3;" prop_checkUnused9 = verifyNotTree checkUnusedAssignments "read ''" -prop_checkUnused10= verifyNotTree checkUnusedAssignments "read -p 'test: '" -prop_checkUnused11= verifyNotTree checkUnusedAssignments "bar=5; export foo[$bar]=3" -prop_checkUnused12= verifyNotTree checkUnusedAssignments "read foo; echo ${!foo}" -prop_checkUnused13= verifyNotTree checkUnusedAssignments "x=(1); (( x[0] ))" -prop_checkUnused14= verifyNotTree checkUnusedAssignments "x=(1); n=0; echo ${x[n]}" -prop_checkUnused15= verifyNotTree checkUnusedAssignments "x=(1); n=0; (( x[n] ))" -prop_checkUnused16= verifyNotTree checkUnusedAssignments "foo=5; declare -x foo" -prop_checkUnused16b= verifyNotTree checkUnusedAssignments "f() { local -x foo; foo=42; bar; }; f" -prop_checkUnused17= verifyNotTree checkUnusedAssignments "read -i 'foo' -e -p 'Input: ' bar; $bar;" -prop_checkUnused18= verifyNotTree checkUnusedAssignments "a=1; arr=( [$a]=42 ); echo \"${arr[@]}\"" -prop_checkUnused19= verifyNotTree checkUnusedAssignments "a=1; let b=a+1; echo $b" -prop_checkUnused20= verifyNotTree checkUnusedAssignments "a=1; PS1='$a'" -prop_checkUnused21= verifyNotTree checkUnusedAssignments "a=1; trap 'echo $a' INT" -prop_checkUnused22= verifyNotTree checkUnusedAssignments "a=1; [ -v a ]" -prop_checkUnused23= verifyNotTree checkUnusedAssignments "a=1; [ -R a ]" -prop_checkUnused24= verifyNotTree checkUnusedAssignments "mapfile -C a b; echo ${b[@]}" -prop_checkUnused25= verifyNotTree checkUnusedAssignments "readarray foo; echo ${foo[@]}" -prop_checkUnused26= verifyNotTree checkUnusedAssignments "declare -F foo" -prop_checkUnused27= verifyTree checkUnusedAssignments "var=3; [ var -eq 3 ]" -prop_checkUnused28= verifyNotTree checkUnusedAssignments "var=3; [[ var -eq 3 ]]" -prop_checkUnused29= verifyNotTree checkUnusedAssignments "var=(a b); declare -p var" -prop_checkUnused30= verifyTree checkUnusedAssignments "let a=1" -prop_checkUnused31= verifyTree checkUnusedAssignments "let 'a=1'" -prop_checkUnused32= verifyTree checkUnusedAssignments "let a=b=c; echo $a" -prop_checkUnused33= verifyNotTree checkUnusedAssignments "a=foo; [[ foo =~ ^{$a}$ ]]" -prop_checkUnused34= verifyNotTree checkUnusedAssignments "foo=1; (( t = foo )); echo $t" -prop_checkUnused35= verifyNotTree checkUnusedAssignments "a=foo; b=2; echo ${a:b}" -prop_checkUnused36= verifyNotTree checkUnusedAssignments "if [[ -v foo ]]; then true; fi" -prop_checkUnused37= verifyNotTree checkUnusedAssignments "fd=2; exec {fd}>&-" -prop_checkUnused38= verifyTree checkUnusedAssignments "(( a=42 ))" -prop_checkUnused39= verifyNotTree checkUnusedAssignments "declare -x -f foo" -prop_checkUnused40= verifyNotTree checkUnusedAssignments "arr=(1 2); num=2; echo \"${arr[@]:num}\"" -prop_checkUnused41= verifyNotTree checkUnusedAssignments "@test 'foo' {\ntrue\n}\n" -prop_checkUnused42= verifyNotTree checkUnusedAssignments "DEFINE_string foo '' ''; echo \"${FLAGS_foo}\"" -prop_checkUnused43= verifyTree checkUnusedAssignments "DEFINE_string foo '' ''" -prop_checkUnused44= verifyNotTree checkUnusedAssignments "DEFINE_string \"foo$ibar\" x y" -prop_checkUnused45= verifyTree checkUnusedAssignments "readonly foo=bar" -prop_checkUnused46= verifyTree checkUnusedAssignments "readonly foo=(bar)" -prop_checkUnused47= verifyNotTree checkUnusedAssignments "a=1; alias hello='echo $a'" -prop_checkUnused48= verifyNotTree checkUnusedAssignments "_a=1" -prop_checkUnused49= verifyNotTree checkUnusedAssignments "declare -A array; key=a; [[ -v array[$key] ]]" -prop_checkUnused50= verifyNotTree checkUnusedAssignments "foofunc() { :; }; typeset -fx foofunc" -prop_checkUnused51= verifyTree checkUnusedAssignments "x[y[z=1]]=1; echo ${x[@]}" +prop_checkUnused10 = verifyNotTree checkUnusedAssignments "read -p 'test: '" +prop_checkUnused11 = verifyNotTree checkUnusedAssignments "bar=5; export foo[$bar]=3" +prop_checkUnused12 = verifyNotTree checkUnusedAssignments "read foo; echo ${!foo}" +prop_checkUnused13 = verifyNotTree checkUnusedAssignments "x=(1); (( x[0] ))" +prop_checkUnused14 = verifyNotTree checkUnusedAssignments "x=(1); n=0; echo ${x[n]}" +prop_checkUnused15 = verifyNotTree checkUnusedAssignments "x=(1); n=0; (( x[n] ))" +prop_checkUnused16 = verifyNotTree checkUnusedAssignments "foo=5; declare -x foo" +prop_checkUnused16b = verifyNotTree checkUnusedAssignments "f() { local -x foo; foo=42; bar; }; f" +prop_checkUnused17 = verifyNotTree checkUnusedAssignments "read -i 'foo' -e -p 'Input: ' bar; $bar;" +prop_checkUnused18 = verifyNotTree checkUnusedAssignments "a=1; arr=( [$a]=42 ); echo \"${arr[@]}\"" +prop_checkUnused19 = verifyNotTree checkUnusedAssignments "a=1; let b=a+1; echo $b" +prop_checkUnused20 = verifyNotTree checkUnusedAssignments "a=1; PS1='$a'" +prop_checkUnused21 = verifyNotTree checkUnusedAssignments "a=1; trap 'echo $a' INT" +prop_checkUnused22 = verifyNotTree checkUnusedAssignments "a=1; [ -v a ]" +prop_checkUnused23 = verifyNotTree checkUnusedAssignments "a=1; [ -R a ]" +prop_checkUnused24 = verifyNotTree checkUnusedAssignments "mapfile -C a b; echo ${b[@]}" +prop_checkUnused25 = verifyNotTree checkUnusedAssignments "readarray foo; echo ${foo[@]}" +prop_checkUnused26 = verifyNotTree checkUnusedAssignments "declare -F foo" +prop_checkUnused27 = verifyTree checkUnusedAssignments "var=3; [ var -eq 3 ]" +prop_checkUnused28 = verifyNotTree checkUnusedAssignments "var=3; [[ var -eq 3 ]]" +prop_checkUnused29 = verifyNotTree checkUnusedAssignments "var=(a b); declare -p var" +prop_checkUnused30 = verifyTree checkUnusedAssignments "let a=1" +prop_checkUnused31 = verifyTree checkUnusedAssignments "let 'a=1'" +prop_checkUnused32 = verifyTree checkUnusedAssignments "let a=b=c; echo $a" +prop_checkUnused33 = verifyNotTree checkUnusedAssignments "a=foo; [[ foo =~ ^{$a}$ ]]" +prop_checkUnused34 = verifyNotTree checkUnusedAssignments "foo=1; (( t = foo )); echo $t" +prop_checkUnused35 = verifyNotTree checkUnusedAssignments "a=foo; b=2; echo ${a:b}" +prop_checkUnused36 = verifyNotTree checkUnusedAssignments "if [[ -v foo ]]; then true; fi" +prop_checkUnused37 = verifyNotTree checkUnusedAssignments "fd=2; exec {fd}>&-" +prop_checkUnused38 = verifyTree checkUnusedAssignments "(( a=42 ))" +prop_checkUnused39 = verifyNotTree checkUnusedAssignments "declare -x -f foo" +prop_checkUnused40 = verifyNotTree checkUnusedAssignments "arr=(1 2); num=2; echo \"${arr[@]:num}\"" +prop_checkUnused41 = verifyNotTree checkUnusedAssignments "@test 'foo' {\ntrue\n}\n" +prop_checkUnused42 = verifyNotTree checkUnusedAssignments "DEFINE_string foo '' ''; echo \"${FLAGS_foo}\"" +prop_checkUnused43 = verifyTree checkUnusedAssignments "DEFINE_string foo '' ''" +prop_checkUnused44 = verifyNotTree checkUnusedAssignments "DEFINE_string \"foo$ibar\" x y" +prop_checkUnused45 = verifyTree checkUnusedAssignments "readonly foo=bar" +prop_checkUnused46 = verifyTree checkUnusedAssignments "readonly foo=(bar)" +prop_checkUnused47 = verifyNotTree checkUnusedAssignments "a=1; alias hello='echo $a'" +prop_checkUnused48 = verifyNotTree checkUnusedAssignments "_a=1" +prop_checkUnused49 = verifyNotTree checkUnusedAssignments "declare -A array; key=a; [[ -v array[$key] ]]" +prop_checkUnused50 = verifyNotTree checkUnusedAssignments "foofunc() { :; }; typeset -fx foofunc" +prop_checkUnused51 = verifyTree checkUnusedAssignments "x[y[z=1]]=1; echo ${x[@]}" checkUnusedAssignments params t = execWriter (mapM_ warnFor unused) where @@ -2381,40 +2381,40 @@ prop_checkUnassignedReferences6 = verifyNotTree checkUnassignedReferences "foo=. prop_checkUnassignedReferences7 = verifyNotTree checkUnassignedReferences "getopts ':h' foo; echo $foo" prop_checkUnassignedReferences8 = verifyNotTree checkUnassignedReferences "let 'foo = 1'; echo $foo" prop_checkUnassignedReferences9 = verifyNotTree checkUnassignedReferences "echo ${foo-bar}" -prop_checkUnassignedReferences10= verifyNotTree checkUnassignedReferences "echo ${foo:?}" -prop_checkUnassignedReferences11= verifyNotTree checkUnassignedReferences "declare -A foo; echo \"${foo[@]}\"" -prop_checkUnassignedReferences12= verifyNotTree checkUnassignedReferences "typeset -a foo; echo \"${foo[@]}\"" -prop_checkUnassignedReferences13= verifyNotTree checkUnassignedReferences "f() { local foo; echo $foo; }" -prop_checkUnassignedReferences14= verifyNotTree checkUnassignedReferences "foo=; echo $foo" -prop_checkUnassignedReferences15= verifyNotTree checkUnassignedReferences "f() { true; }; export -f f" -prop_checkUnassignedReferences16= verifyNotTree checkUnassignedReferences "declare -A foo=( [a b]=bar ); echo ${foo[a b]}" -prop_checkUnassignedReferences17= verifyNotTree checkUnassignedReferences "USERS=foo; echo $USER" -prop_checkUnassignedReferences18= verifyNotTree checkUnassignedReferences "FOOBAR=42; export FOOBAR=" -prop_checkUnassignedReferences19= verifyNotTree checkUnassignedReferences "readonly foo=bar; echo $foo" -prop_checkUnassignedReferences20= verifyNotTree checkUnassignedReferences "printf -v foo bar; echo $foo" -prop_checkUnassignedReferences21= verifyTree checkUnassignedReferences "echo ${#foo}" -prop_checkUnassignedReferences22= verifyNotTree checkUnassignedReferences "echo ${!os*}" -prop_checkUnassignedReferences23= verifyTree checkUnassignedReferences "declare -a foo; foo[bar]=42;" -prop_checkUnassignedReferences24= verifyNotTree checkUnassignedReferences "declare -A foo; foo[bar]=42;" -prop_checkUnassignedReferences25= verifyNotTree checkUnassignedReferences "declare -A foo=(); foo[bar]=42;" -prop_checkUnassignedReferences26= verifyNotTree checkUnassignedReferences "a::b() { foo; }; readonly -f a::b" -prop_checkUnassignedReferences27= verifyNotTree checkUnassignedReferences ": ${foo:=bar}" -prop_checkUnassignedReferences28= verifyNotTree checkUnassignedReferences "#!/bin/ksh\necho \"${.sh.version}\"\n" -prop_checkUnassignedReferences29= verifyNotTree checkUnassignedReferences "if [[ -v foo ]]; then echo $foo; fi" -prop_checkUnassignedReferences30= verifyNotTree checkUnassignedReferences "if [[ -v foo[3] ]]; then echo ${foo[3]}; fi" -prop_checkUnassignedReferences31= verifyNotTree checkUnassignedReferences "X=1; if [[ -v foo[$X+42] ]]; then echo ${foo[$X+42]}; fi" -prop_checkUnassignedReferences32= verifyNotTree checkUnassignedReferences "if [[ -v \"foo[1]\" ]]; then echo ${foo[@]}; fi" -prop_checkUnassignedReferences33= verifyNotTree checkUnassignedReferences "f() { local -A foo; echo \"${foo[@]}\"; }" -prop_checkUnassignedReferences34= verifyNotTree checkUnassignedReferences "declare -A foo; (( foo[bar] ))" -prop_checkUnassignedReferences35= verifyNotTree checkUnassignedReferences "echo ${arr[foo-bar]:?fail}" -prop_checkUnassignedReferences36= verifyNotTree checkUnassignedReferences "read -a foo -r <<<\"foo bar\"; echo \"$foo\"" -prop_checkUnassignedReferences37= verifyNotTree checkUnassignedReferences "var=howdy; printf -v 'array[0]' %s \"$var\"; printf %s \"${array[0]}\";" -prop_checkUnassignedReferences38= verifyTree (checkUnassignedReferences' True) "echo $VAR" -prop_checkUnassignedReferences39= verifyNotTree checkUnassignedReferences "builtin export var=4; echo $var" -prop_checkUnassignedReferences40= verifyNotTree checkUnassignedReferences ": ${foo=bar}" -prop_checkUnassignedReferences41= verifyNotTree checkUnassignedReferences "mapfile -t files 123; echo \"${files[@]}\"" -prop_checkUnassignedReferences42= verifyNotTree checkUnassignedReferences "mapfile files -t; echo \"${files[@]}\"" -prop_checkUnassignedReferences43= verifyNotTree checkUnassignedReferences "mapfile --future files; echo \"${files[@]}\"" +prop_checkUnassignedReferences10 = verifyNotTree checkUnassignedReferences "echo ${foo:?}" +prop_checkUnassignedReferences11 = verifyNotTree checkUnassignedReferences "declare -A foo; echo \"${foo[@]}\"" +prop_checkUnassignedReferences12 = verifyNotTree checkUnassignedReferences "typeset -a foo; echo \"${foo[@]}\"" +prop_checkUnassignedReferences13 = verifyNotTree checkUnassignedReferences "f() { local foo; echo $foo; }" +prop_checkUnassignedReferences14 = verifyNotTree checkUnassignedReferences "foo=; echo $foo" +prop_checkUnassignedReferences15 = verifyNotTree checkUnassignedReferences "f() { true; }; export -f f" +prop_checkUnassignedReferences16 = verifyNotTree checkUnassignedReferences "declare -A foo=( [a b]=bar ); echo ${foo[a b]}" +prop_checkUnassignedReferences17 = verifyNotTree checkUnassignedReferences "USERS=foo; echo $USER" +prop_checkUnassignedReferences18 = verifyNotTree checkUnassignedReferences "FOOBAR=42; export FOOBAR=" +prop_checkUnassignedReferences19 = verifyNotTree checkUnassignedReferences "readonly foo=bar; echo $foo" +prop_checkUnassignedReferences20 = verifyNotTree checkUnassignedReferences "printf -v foo bar; echo $foo" +prop_checkUnassignedReferences21 = verifyTree checkUnassignedReferences "echo ${#foo}" +prop_checkUnassignedReferences22 = verifyNotTree checkUnassignedReferences "echo ${!os*}" +prop_checkUnassignedReferences23 = verifyTree checkUnassignedReferences "declare -a foo; foo[bar]=42;" +prop_checkUnassignedReferences24 = verifyNotTree checkUnassignedReferences "declare -A foo; foo[bar]=42;" +prop_checkUnassignedReferences25 = verifyNotTree checkUnassignedReferences "declare -A foo=(); foo[bar]=42;" +prop_checkUnassignedReferences26 = verifyNotTree checkUnassignedReferences "a::b() { foo; }; readonly -f a::b" +prop_checkUnassignedReferences27 = verifyNotTree checkUnassignedReferences ": ${foo:=bar}" +prop_checkUnassignedReferences28 = verifyNotTree checkUnassignedReferences "#!/bin/ksh\necho \"${.sh.version}\"\n" +prop_checkUnassignedReferences29 = verifyNotTree checkUnassignedReferences "if [[ -v foo ]]; then echo $foo; fi" +prop_checkUnassignedReferences30 = verifyNotTree checkUnassignedReferences "if [[ -v foo[3] ]]; then echo ${foo[3]}; fi" +prop_checkUnassignedReferences31 = verifyNotTree checkUnassignedReferences "X=1; if [[ -v foo[$X+42] ]]; then echo ${foo[$X+42]}; fi" +prop_checkUnassignedReferences32 = verifyNotTree checkUnassignedReferences "if [[ -v \"foo[1]\" ]]; then echo ${foo[@]}; fi" +prop_checkUnassignedReferences33 = verifyNotTree checkUnassignedReferences "f() { local -A foo; echo \"${foo[@]}\"; }" +prop_checkUnassignedReferences34 = verifyNotTree checkUnassignedReferences "declare -A foo; (( foo[bar] ))" +prop_checkUnassignedReferences35 = verifyNotTree checkUnassignedReferences "echo ${arr[foo-bar]:?fail}" +prop_checkUnassignedReferences36 = verifyNotTree checkUnassignedReferences "read -a foo -r <<<\"foo bar\"; echo \"$foo\"" +prop_checkUnassignedReferences37 = verifyNotTree checkUnassignedReferences "var=howdy; printf -v 'array[0]' %s \"$var\"; printf %s \"${array[0]}\";" +prop_checkUnassignedReferences38 = verifyTree (checkUnassignedReferences' True) "echo $VAR" +prop_checkUnassignedReferences39 = verifyNotTree checkUnassignedReferences "builtin export var=4; echo $var" +prop_checkUnassignedReferences40 = verifyNotTree checkUnassignedReferences ": ${foo=bar}" +prop_checkUnassignedReferences41 = verifyNotTree checkUnassignedReferences "mapfile -t files 123; echo \"${files[@]}\"" +prop_checkUnassignedReferences42 = verifyNotTree checkUnassignedReferences "mapfile files -t; echo \"${files[@]}\"" +prop_checkUnassignedReferences43 = verifyNotTree checkUnassignedReferences "mapfile --future files; echo \"${files[@]}\"" prop_checkUnassignedReferences_minusNPlain = verifyNotTree checkUnassignedReferences "if [ -n \"$x\" ]; then echo $x; fi" prop_checkUnassignedReferences_minusZPlain = verifyNotTree checkUnassignedReferences "if [ -z \"$x\" ]; then echo \"\"; fi" prop_checkUnassignedReferences_minusNBraced = verifyNotTree checkUnassignedReferences "if [ -n \"${x}\" ]; then echo $x; fi" @@ -2792,11 +2792,11 @@ prop_checkUnpassedInFunctions6 = verifyNotTree checkUnpassedInFunctions "foo() { prop_checkUnpassedInFunctions7 = verifyTree checkUnpassedInFunctions "foo() { echo $1; }; foo; foo;" prop_checkUnpassedInFunctions8 = verifyNotTree checkUnpassedInFunctions "foo() { echo $((1)); }; foo;" prop_checkUnpassedInFunctions9 = verifyNotTree checkUnpassedInFunctions "foo() { echo $(($b)); }; foo;" -prop_checkUnpassedInFunctions10= verifyNotTree checkUnpassedInFunctions "foo() { echo $!; }; foo;" -prop_checkUnpassedInFunctions11= verifyNotTree checkUnpassedInFunctions "foo() { bar() { echo $1; }; bar baz; }; foo;" -prop_checkUnpassedInFunctions12= verifyNotTree checkUnpassedInFunctions "foo() { echo ${!var*}; }; foo;" -prop_checkUnpassedInFunctions13= verifyNotTree checkUnpassedInFunctions "# shellcheck disable=SC2120\nfoo() { echo $1; }\nfoo\n" -prop_checkUnpassedInFunctions14= verifyTree checkUnpassedInFunctions "foo() { echo $#; }; foo" +prop_checkUnpassedInFunctions10 = verifyNotTree checkUnpassedInFunctions "foo() { echo $!; }; foo;" +prop_checkUnpassedInFunctions11 = verifyNotTree checkUnpassedInFunctions "foo() { bar() { echo $1; }; bar baz; }; foo;" +prop_checkUnpassedInFunctions12 = verifyNotTree checkUnpassedInFunctions "foo() { echo ${!var*}; }; foo;" +prop_checkUnpassedInFunctions13 = verifyNotTree checkUnpassedInFunctions "# shellcheck disable=SC2120\nfoo() { echo $1; }\nfoo\n" +prop_checkUnpassedInFunctions14 = verifyTree checkUnpassedInFunctions "foo() { echo $#; }; foo" checkUnpassedInFunctions params root = execWriter $ mapM_ warnForGroup referenceGroups where @@ -2971,12 +2971,12 @@ checkSuspiciousIFS params (T_Assignment _ _ "IFS" [] value) = checkSuspiciousIFS _ _ = return () -prop_checkGrepQ1= verify checkShouldUseGrepQ "[[ $(foo | grep bar) ]]" -prop_checkGrepQ2= verify checkShouldUseGrepQ "[ -z $(fgrep lol) ]" -prop_checkGrepQ3= verify checkShouldUseGrepQ "[ -n \"$(foo | zgrep lol)\" ]" -prop_checkGrepQ4= verifyNot checkShouldUseGrepQ "[ -z $(grep bar | cmd) ]" -prop_checkGrepQ5= verifyNot checkShouldUseGrepQ "rm $(ls | grep file)" -prop_checkGrepQ6= verifyNot checkShouldUseGrepQ "[[ -n $(pgrep foo) ]]" +prop_checkGrepQ1 = verify checkShouldUseGrepQ "[[ $(foo | grep bar) ]]" +prop_checkGrepQ2 = verify checkShouldUseGrepQ "[ -z $(fgrep lol) ]" +prop_checkGrepQ3 = verify checkShouldUseGrepQ "[ -n \"$(foo | zgrep lol)\" ]" +prop_checkGrepQ4 = verifyNot checkShouldUseGrepQ "[ -z $(grep bar | cmd) ]" +prop_checkGrepQ5 = verifyNot checkShouldUseGrepQ "rm $(ls | grep file)" +prop_checkGrepQ6 = verifyNot checkShouldUseGrepQ "[[ -n $(pgrep foo) ]]" checkShouldUseGrepQ params t = sequence_ $ case t of TC_Nullary id _ token -> check id True token diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index acbf967..4bae17e 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -216,18 +216,18 @@ checker spec params = getChecker $ commandChecks ++ optionals prop_checkTr1 = verify checkTr "tr [a-f] [A-F]" prop_checkTr2 = verify checkTr "tr 'a-z' 'A-Z'" -prop_checkTr2a= verify checkTr "tr '[a-z]' '[A-Z]'" +prop_checkTr2a = verify checkTr "tr '[a-z]' '[A-Z]'" prop_checkTr3 = verifyNot checkTr "tr -d '[:lower:]'" -prop_checkTr3a= verifyNot checkTr "tr -d '[:upper:]'" -prop_checkTr3b= verifyNot checkTr "tr -d '|/_[:upper:]'" +prop_checkTr3a = verifyNot checkTr "tr -d '[:upper:]'" +prop_checkTr3b = verifyNot checkTr "tr -d '|/_[:upper:]'" prop_checkTr4 = verifyNot checkTr "ls [a-z]" prop_checkTr5 = verify checkTr "tr foo bar" prop_checkTr6 = verify checkTr "tr 'hello' 'world'" prop_checkTr8 = verifyNot checkTr "tr aeiou _____" prop_checkTr9 = verifyNot checkTr "a-z n-za-m" -prop_checkTr10= verifyNot checkTr "tr --squeeze-repeats rl lr" -prop_checkTr11= verifyNot checkTr "tr abc '[d*]'" -prop_checkTr12= verifyNot checkTr "tr '[=e=]' 'e'" +prop_checkTr10 = verifyNot checkTr "tr --squeeze-repeats rl lr" +prop_checkTr11 = verifyNot checkTr "tr abc '[d*]'" +prop_checkTr12 = verifyNot checkTr "tr '[=e=]' 'e'" checkTr = CommandCheck (Basename "tr") (mapM_ f . arguments) where f w | isGlob w = -- The user will go [ab] -> '[ab]' -> 'ab'. Fixme? @@ -339,20 +339,20 @@ prop_checkGrepRe6 = verifyNot checkGrepRe "grep foo \\*.mp3" prop_checkGrepRe7 = verify checkGrepRe "grep *foo* file" prop_checkGrepRe8 = verify checkGrepRe "ls | grep foo*.jpg" prop_checkGrepRe9 = verifyNot checkGrepRe "grep '[0-9]*' file" -prop_checkGrepRe10= verifyNot checkGrepRe "grep '^aa*' file" -prop_checkGrepRe11= verifyNot checkGrepRe "grep --include=*.png foo" -prop_checkGrepRe12= verifyNot checkGrepRe "grep -F 'Foo*' file" -prop_checkGrepRe13= verifyNot checkGrepRe "grep -- -foo bar*" -prop_checkGrepRe14= verifyNot checkGrepRe "grep -e -foo bar*" -prop_checkGrepRe15= verifyNot checkGrepRe "grep --regex -foo bar*" -prop_checkGrepRe16= verifyNot checkGrepRe "grep --include 'Foo*' file" -prop_checkGrepRe17= verifyNot checkGrepRe "grep --exclude 'Foo*' file" -prop_checkGrepRe18= verifyNot checkGrepRe "grep --exclude-dir 'Foo*' file" -prop_checkGrepRe19= verify checkGrepRe "grep -- 'Foo*' file" -prop_checkGrepRe20= verifyNot checkGrepRe "grep --fixed-strings 'Foo*' file" -prop_checkGrepRe21= verifyNot checkGrepRe "grep -o 'x*' file" -prop_checkGrepRe22= verifyNot checkGrepRe "grep --only-matching 'x*' file" -prop_checkGrepRe23= verifyNot checkGrepRe "grep '.*' file" +prop_checkGrepRe10 = verifyNot checkGrepRe "grep '^aa*' file" +prop_checkGrepRe11 = verifyNot checkGrepRe "grep --include=*.png foo" +prop_checkGrepRe12 = verifyNot checkGrepRe "grep -F 'Foo*' file" +prop_checkGrepRe13 = verifyNot checkGrepRe "grep -- -foo bar*" +prop_checkGrepRe14 = verifyNot checkGrepRe "grep -e -foo bar*" +prop_checkGrepRe15 = verifyNot checkGrepRe "grep --regex -foo bar*" +prop_checkGrepRe16 = verifyNot checkGrepRe "grep --include 'Foo*' file" +prop_checkGrepRe17 = verifyNot checkGrepRe "grep --exclude 'Foo*' file" +prop_checkGrepRe18 = verifyNot checkGrepRe "grep --exclude-dir 'Foo*' file" +prop_checkGrepRe19 = verify checkGrepRe "grep -- 'Foo*' file" +prop_checkGrepRe20 = verifyNot checkGrepRe "grep --fixed-strings 'Foo*' file" +prop_checkGrepRe21 = verifyNot checkGrepRe "grep -o 'x*' file" +prop_checkGrepRe22 = verifyNot checkGrepRe "grep --only-matching 'x*' file" +prop_checkGrepRe23 = verifyNot checkGrepRe "grep '.*' file" checkGrepRe = CommandCheck (Basename "grep") check where check cmd = f cmd (arguments cmd) @@ -400,7 +400,7 @@ checkGrepRe = CommandCheck (Basename "grep") check where prop_checkTrapQuotes1 = verify checkTrapQuotes "trap \"echo $num\" INT" -prop_checkTrapQuotes1a= verify checkTrapQuotes "trap \"echo `ls`\" INT" +prop_checkTrapQuotes1a = verify checkTrapQuotes "trap \"echo `ls`\" INT" prop_checkTrapQuotes2 = verifyNot checkTrapQuotes "trap 'echo $num' INT" prop_checkTrapQuotes3 = verify checkTrapQuotes "trap \"echo $((1+num))\" EXIT DEBUG" checkTrapQuotes = CommandCheck (Exactly "trap") (f . arguments) where @@ -657,19 +657,19 @@ prop_checkPrintfVar6 = verify checkPrintfVar "printf foo bar baz" prop_checkPrintfVar7 = verify checkPrintfVar "printf -- foo bar baz" prop_checkPrintfVar8 = verifyNot checkPrintfVar "printf '%s %s %s' \"${var[@]}\"" prop_checkPrintfVar9 = verifyNot checkPrintfVar "printf '%s %s %s\\n' *.png" -prop_checkPrintfVar10= verifyNot checkPrintfVar "printf '%s %s %s' foo bar baz" -prop_checkPrintfVar11= verifyNot checkPrintfVar "printf '%(%s%s)T' -1" -prop_checkPrintfVar12= verify checkPrintfVar "printf '%s %s\\n' 1 2 3" -prop_checkPrintfVar13= verifyNot checkPrintfVar "printf '%s %s\\n' 1 2 3 4" -prop_checkPrintfVar14= verify checkPrintfVar "printf '%*s\\n' 1" -prop_checkPrintfVar15= verifyNot checkPrintfVar "printf '%*s\\n' 1 2" -prop_checkPrintfVar16= verifyNot checkPrintfVar "printf $'string'" -prop_checkPrintfVar17= verify checkPrintfVar "printf '%-*s\\n' 1" -prop_checkPrintfVar18= verifyNot checkPrintfVar "printf '%-*s\\n' 1 2" -prop_checkPrintfVar19= verifyNot checkPrintfVar "printf '%(%s)T'" -prop_checkPrintfVar20= verifyNot checkPrintfVar "printf '%d %(%s)T' 42" -prop_checkPrintfVar21= verify checkPrintfVar "printf '%d %(%s)T'" -prop_checkPrintfVar22= verify checkPrintfVar "printf '%s\n%s' foo" +prop_checkPrintfVar10 = verifyNot checkPrintfVar "printf '%s %s %s' foo bar baz" +prop_checkPrintfVar11 = verifyNot checkPrintfVar "printf '%(%s%s)T' -1" +prop_checkPrintfVar12 = verify checkPrintfVar "printf '%s %s\\n' 1 2 3" +prop_checkPrintfVar13 = verifyNot checkPrintfVar "printf '%s %s\\n' 1 2 3 4" +prop_checkPrintfVar14 = verify checkPrintfVar "printf '%*s\\n' 1" +prop_checkPrintfVar15 = verifyNot checkPrintfVar "printf '%*s\\n' 1 2" +prop_checkPrintfVar16 = verifyNot checkPrintfVar "printf $'string'" +prop_checkPrintfVar17 = verify checkPrintfVar "printf '%-*s\\n' 1" +prop_checkPrintfVar18 = verifyNot checkPrintfVar "printf '%-*s\\n' 1 2" +prop_checkPrintfVar19 = verifyNot checkPrintfVar "printf '%(%s)T'" +prop_checkPrintfVar20 = verifyNot checkPrintfVar "printf '%d %(%s)T' 42" +prop_checkPrintfVar21 = verify checkPrintfVar "printf '%d %(%s)T'" +prop_checkPrintfVar22 = verify checkPrintfVar "printf '%s\n%s' foo" checkPrintfVar = CommandCheck (Exactly "printf") (f . arguments) where f (doubledash:rest) | getLiteralString doubledash == Just "--" = f rest @@ -1069,10 +1069,10 @@ prop_checkCatastrophicRm4 = verify checkCatastrophicRm "rm -fr /home/$(whoami)/* prop_checkCatastrophicRm5 = verifyNot checkCatastrophicRm "rm -r /home/${USER:-thing}/*" prop_checkCatastrophicRm6 = verify checkCatastrophicRm "rm --recursive /etc/*$config*" prop_checkCatastrophicRm8 = verify checkCatastrophicRm "rm -rf /home" -prop_checkCatastrophicRm10= verifyNot checkCatastrophicRm "rm -r \"${DIR}\"/{.gitignore,.gitattributes,ci}" -prop_checkCatastrophicRm11= verify checkCatastrophicRm "rm -r /{bin,sbin}/$exec" -prop_checkCatastrophicRm12= verify checkCatastrophicRm "rm -r /{{usr,},{bin,sbin}}/$exec" -prop_checkCatastrophicRm13= verifyNot checkCatastrophicRm "rm -r /{{a,b},{c,d}}/$exec" +prop_checkCatastrophicRm10 = verifyNot checkCatastrophicRm "rm -r \"${DIR}\"/{.gitignore,.gitattributes,ci}" +prop_checkCatastrophicRm11 = verify checkCatastrophicRm "rm -r /{bin,sbin}/$exec" +prop_checkCatastrophicRm12 = verify checkCatastrophicRm "rm -r /{{usr,},{bin,sbin}}/$exec" +prop_checkCatastrophicRm13 = verifyNot checkCatastrophicRm "rm -r /{{a,b},{c,d}}/$exec" prop_checkCatastrophicRmA = verify checkCatastrophicRm "rm -rf /usr /lib/nvidia-current/xorg/xorg" prop_checkCatastrophicRmB = verify checkCatastrophicRm "rm -rf \"$STEAMROOT/\"*" checkCatastrophicRm = CommandCheck (Basename "rm") $ \t -> diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 9ad17f5..c12da2d 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -92,55 +92,55 @@ prop_checkBashisms6 = verify checkBashisms "[ \"$a\" == 42 ]" prop_checkBashisms7 = verify checkBashisms "echo ${var[1]}" prop_checkBashisms8 = verify checkBashisms "echo ${!var[@]}" prop_checkBashisms9 = verify checkBashisms "echo ${!var*}" -prop_checkBashisms10= verify checkBashisms "echo ${var:4:12}" -prop_checkBashisms11= verifyNot checkBashisms "echo ${var:-4}" -prop_checkBashisms12= verify checkBashisms "echo ${var//foo/bar}" -prop_checkBashisms13= verify checkBashisms "exec -c env" -prop_checkBashisms14= verify checkBashisms "echo -n \"Foo: \"" -prop_checkBashisms15= verify checkBashisms "let n++" -prop_checkBashisms16= verify checkBashisms "echo $RANDOM" -prop_checkBashisms17= verify checkBashisms "echo $((RANDOM%6+1))" -prop_checkBashisms18= verify checkBashisms "foo &> /dev/null" -prop_checkBashisms19= verify checkBashisms "foo > file*.txt" -prop_checkBashisms20= verify checkBashisms "read -ra foo" -prop_checkBashisms21= verify checkBashisms "[ -a foo ]" -prop_checkBashisms22= verifyNot checkBashisms "[ foo -a bar ]" -prop_checkBashisms23= verify checkBashisms "trap mything ERR INT" -prop_checkBashisms24= verifyNot checkBashisms "trap mything INT TERM" -prop_checkBashisms25= verify checkBashisms "cat < /dev/tcp/host/123" -prop_checkBashisms26= verify checkBashisms "trap mything ERR SIGTERM" -prop_checkBashisms27= verify checkBashisms "echo *[^0-9]*" -prop_checkBashisms28= verify checkBashisms "exec {n}>&2" -prop_checkBashisms29= verify checkBashisms "echo ${!var}" -prop_checkBashisms30= verify checkBashisms "printf -v '%s' \"$1\"" -prop_checkBashisms31= verify checkBashisms "printf '%q' \"$1\"" -prop_checkBashisms32= verifyNot checkBashisms "#!/bin/dash\n[ foo -nt bar ]" -prop_checkBashisms33= verify checkBashisms "#!/bin/sh\necho -n foo" -prop_checkBashisms34= verifyNot checkBashisms "#!/bin/dash\necho -n foo" -prop_checkBashisms35= verifyNot checkBashisms "#!/bin/dash\nlocal foo" -prop_checkBashisms36= verifyNot checkBashisms "#!/bin/dash\nread -p foo -r bar" -prop_checkBashisms37= verifyNot checkBashisms "HOSTNAME=foo; echo $HOSTNAME" -prop_checkBashisms38= verify checkBashisms "RANDOM=9; echo $RANDOM" -prop_checkBashisms39= verify checkBashisms "foo-bar() { true; }" -prop_checkBashisms40= verify checkBashisms "echo $(/dev/null" -prop_checkBashisms48= verifyNot checkBashisms "#!/bin/sh\necho $LINENO" -prop_checkBashisms49= verify checkBashisms "#!/bin/dash\necho $MACHTYPE" -prop_checkBashisms50= verify checkBashisms "#!/bin/sh\ncmd >& file" -prop_checkBashisms51= verifyNot checkBashisms "#!/bin/sh\ncmd 2>&1" -prop_checkBashisms52= verifyNot checkBashisms "#!/bin/sh\ncmd >&2" -prop_checkBashisms53= verifyNot checkBashisms "#!/bin/sh\nprintf -- -f\n" -prop_checkBashisms54= verify checkBashisms "#!/bin/sh\nfoo+=bar" -prop_checkBashisms55= verify checkBashisms "#!/bin/sh\necho ${@%foo}" -prop_checkBashisms56= verifyNot checkBashisms "#!/bin/sh\necho ${##}" -prop_checkBashisms57= verifyNot checkBashisms "#!/bin/dash\nulimit -c 0" -prop_checkBashisms58= verify checkBashisms "#!/bin/sh\nulimit -c 0" +prop_checkBashisms10 = verify checkBashisms "echo ${var:4:12}" +prop_checkBashisms11 = verifyNot checkBashisms "echo ${var:-4}" +prop_checkBashisms12 = verify checkBashisms "echo ${var//foo/bar}" +prop_checkBashisms13 = verify checkBashisms "exec -c env" +prop_checkBashisms14 = verify checkBashisms "echo -n \"Foo: \"" +prop_checkBashisms15 = verify checkBashisms "let n++" +prop_checkBashisms16 = verify checkBashisms "echo $RANDOM" +prop_checkBashisms17 = verify checkBashisms "echo $((RANDOM%6+1))" +prop_checkBashisms18 = verify checkBashisms "foo &> /dev/null" +prop_checkBashisms19 = verify checkBashisms "foo > file*.txt" +prop_checkBashisms20 = verify checkBashisms "read -ra foo" +prop_checkBashisms21 = verify checkBashisms "[ -a foo ]" +prop_checkBashisms22 = verifyNot checkBashisms "[ foo -a bar ]" +prop_checkBashisms23 = verify checkBashisms "trap mything ERR INT" +prop_checkBashisms24 = verifyNot checkBashisms "trap mything INT TERM" +prop_checkBashisms25 = verify checkBashisms "cat < /dev/tcp/host/123" +prop_checkBashisms26 = verify checkBashisms "trap mything ERR SIGTERM" +prop_checkBashisms27 = verify checkBashisms "echo *[^0-9]*" +prop_checkBashisms28 = verify checkBashisms "exec {n}>&2" +prop_checkBashisms29 = verify checkBashisms "echo ${!var}" +prop_checkBashisms30 = verify checkBashisms "printf -v '%s' \"$1\"" +prop_checkBashisms31 = verify checkBashisms "printf '%q' \"$1\"" +prop_checkBashisms32 = verifyNot checkBashisms "#!/bin/dash\n[ foo -nt bar ]" +prop_checkBashisms33 = verify checkBashisms "#!/bin/sh\necho -n foo" +prop_checkBashisms34 = verifyNot checkBashisms "#!/bin/dash\necho -n foo" +prop_checkBashisms35 = verifyNot checkBashisms "#!/bin/dash\nlocal foo" +prop_checkBashisms36 = verifyNot checkBashisms "#!/bin/dash\nread -p foo -r bar" +prop_checkBashisms37 = verifyNot checkBashisms "HOSTNAME=foo; echo $HOSTNAME" +prop_checkBashisms38 = verify checkBashisms "RANDOM=9; echo $RANDOM" +prop_checkBashisms39 = verify checkBashisms "foo-bar() { true; }" +prop_checkBashisms40 = verify checkBashisms "echo $(/dev/null" +prop_checkBashisms48 = verifyNot checkBashisms "#!/bin/sh\necho $LINENO" +prop_checkBashisms49 = verify checkBashisms "#!/bin/dash\necho $MACHTYPE" +prop_checkBashisms50 = verify checkBashisms "#!/bin/sh\ncmd >& file" +prop_checkBashisms51 = verifyNot checkBashisms "#!/bin/sh\ncmd 2>&1" +prop_checkBashisms52 = verifyNot checkBashisms "#!/bin/sh\ncmd >&2" +prop_checkBashisms53 = verifyNot checkBashisms "#!/bin/sh\nprintf -- -f\n" +prop_checkBashisms54 = verify checkBashisms "#!/bin/sh\nfoo+=bar" +prop_checkBashisms55 = verify checkBashisms "#!/bin/sh\necho ${@%foo}" +prop_checkBashisms56 = verifyNot checkBashisms "#!/bin/sh\necho ${##}" +prop_checkBashisms57 = verifyNot checkBashisms "#!/bin/dash\nulimit -c 0" +prop_checkBashisms58 = verify checkBashisms "#!/bin/sh\nulimit -c 0" prop_checkBashisms59 = verify checkBashisms "#!/bin/sh\njobs -s" prop_checkBashisms60 = verifyNot checkBashisms "#!/bin/sh\njobs -p" prop_checkBashisms61 = verifyNot checkBashisms "#!/bin/sh\njobs -lp" @@ -441,9 +441,9 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do _ -> False prop_checkEchoSed1 = verify checkEchoSed "FOO=$(echo \"$cow\" | sed 's/foo/bar/g')" -prop_checkEchoSed1b= verify checkEchoSed "FOO=$(sed 's/foo/bar/g' <<< \"$cow\")" +prop_checkEchoSed1b = verify checkEchoSed "FOO=$(sed 's/foo/bar/g' <<< \"$cow\")" prop_checkEchoSed2 = verify checkEchoSed "rm $(echo $cow | sed -e 's,foo,bar,')" -prop_checkEchoSed2b= verify checkEchoSed "rm $(sed -e 's,foo,bar,' <<< $cow)" +prop_checkEchoSed2b = verify checkEchoSed "rm $(sed -e 's,foo,bar,' <<< $cow)" checkEchoSed = ForShell [Bash, Ksh] f where f (T_Redirecting id lefts r) = @@ -529,11 +529,11 @@ checkMultiDimensionalArrays = ForShell [Bash] f isMultiDim l = getBracedModifier (concat $ oversimplify l) `matches` re prop_checkPS11 = verify checkPS1Assignments "PS1='\\033[1;35m\\$ '" -prop_checkPS11a= verify checkPS1Assignments "export PS1='\\033[1;35m\\$ '" +prop_checkPS11a = verify checkPS1Assignments "export PS1='\\033[1;35m\\$ '" prop_checkPSf2 = verify checkPS1Assignments "PS1='\\h \\e[0m\\$ '" prop_checkPS13 = verify checkPS1Assignments "PS1=$'\\x1b[c '" prop_checkPS14 = verify checkPS1Assignments "PS1=$'\\e[3m; '" -prop_checkPS14a= verify checkPS1Assignments "export PS1=$'\\e[3m; '" +prop_checkPS14a = verify checkPS1Assignments "export PS1=$'\\e[3m; '" prop_checkPS15 = verifyNot checkPS1Assignments "PS1='\\[\\033[1;35m\\]\\$ '" prop_checkPS16 = verifyNot checkPS1Assignments "PS1='\\[\\e1m\\e[1m\\]\\$ '" prop_checkPS17 = verifyNot checkPS1Assignments "PS1='e033x1B'" diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 9f9241c..e6a2999 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -719,20 +719,20 @@ prop_a6 = isOk readArithmeticContents " 1 | 2 ||3|4" prop_a7 = isOk readArithmeticContents "3*2**10" prop_a8 = isOk readArithmeticContents "3" prop_a9 = isOk readArithmeticContents "a^!-b" -prop_a10= isOk readArithmeticContents "! $?" -prop_a11= isOk readArithmeticContents "10#08 * 16#f" -prop_a12= isOk readArithmeticContents "\"$((3+2))\" + '37'" -prop_a13= isOk readArithmeticContents "foo[9*y+x]++" -prop_a14= isOk readArithmeticContents "1+`echo 2`" -prop_a15= isOk readArithmeticContents "foo[`echo foo | sed s/foo/4/g` * 3] + 4" -prop_a16= isOk readArithmeticContents "$foo$bar" -prop_a17= isOk readArithmeticContents "i<(0+(1+1))" -prop_a18= isOk readArithmeticContents "a?b:c" -prop_a19= isOk readArithmeticContents "\\\n3 +\\\n 2" -prop_a20= isOk readArithmeticContents "a ? b ? c : d : e" -prop_a21= isOk readArithmeticContents "a ? b : c ? d : e" -prop_a22= isOk readArithmeticContents "!!a" -prop_a23= isOk readArithmeticContents "~0" +prop_a10 = isOk readArithmeticContents "! $?" +prop_a11 = isOk readArithmeticContents "10#08 * 16#f" +prop_a12 = isOk readArithmeticContents "\"$((3+2))\" + '37'" +prop_a13 = isOk readArithmeticContents "foo[9*y+x]++" +prop_a14 = isOk readArithmeticContents "1+`echo 2`" +prop_a15 = isOk readArithmeticContents "foo[`echo foo | sed s/foo/4/g` * 3] + 4" +prop_a16 = isOk readArithmeticContents "$foo$bar" +prop_a17 = isOk readArithmeticContents "i<(0+(1+1))" +prop_a18 = isOk readArithmeticContents "a?b:c" +prop_a19 = isOk readArithmeticContents "\\\n3 +\\\n 2" +prop_a20 = isOk readArithmeticContents "a ? b ? c : d : e" +prop_a21 = isOk readArithmeticContents "a ? b : c ? d : e" +prop_a22 = isOk readArithmeticContents "!!a" +prop_a23 = isOk readArithmeticContents "~0" readArithmeticContents :: Monad m => SCParser m Token readArithmeticContents = readSequence @@ -925,8 +925,8 @@ prop_readCondition7 = isOk readCondition "[[ ${line} =~ ^[[:space:]]*# ]]" prop_readCondition8 = isOk readCondition "[[ $l =~ ogg|flac ]]" prop_readCondition9 = isOk readCondition "[ foo -a -f bar ]" prop_readCondition10 = isOk readCondition "[[\na == b\n||\nc == d ]]" -prop_readCondition10a= isOk readCondition "[[\na == b ||\nc == d ]]" -prop_readCondition10b= isOk readCondition "[[ a == b\n||\nc == d ]]" +prop_readCondition10a = isOk readCondition "[[\na == b ||\nc == d ]]" +prop_readCondition10b = isOk readCondition "[[ a == b\n||\nc == d ]]" prop_readCondition11 = isOk readCondition "[[ a == b ||\n c == d ]]" prop_readCondition12 = isWarning readCondition "[ a == b \n -o c == d ]" prop_readCondition13 = isOk readCondition "[[ foo =~ ^fo{1,3}$ ]]" @@ -1701,9 +1701,9 @@ readDollarBraced = called "parameter expansion" $ do id <- endSpan start return $ T_DollarBraced id True word -prop_readDollarExpansion1= isOk readDollarExpansion "$(echo foo; ls\n)" -prop_readDollarExpansion2= isOk readDollarExpansion "$( )" -prop_readDollarExpansion3= isOk readDollarExpansion "$( command \n#comment \n)" +prop_readDollarExpansion1 = isOk readDollarExpansion "$(echo foo; ls\n)" +prop_readDollarExpansion2 = isOk readDollarExpansion "$( )" +prop_readDollarExpansion3 = isOk readDollarExpansion "$( command \n#comment \n)" readDollarExpansion = called "command expansion" $ do start <- startSpan try (string "$(") @@ -1795,17 +1795,17 @@ prop_readHereDoc6 = isOk readScript "cat << foo\\ bar\ncow\nfoo bar" prop_readHereDoc7 = isOk readScript "cat << foo\n\\$(f ())\nfoo" prop_readHereDoc8 = isOk readScript "cat <>bar\netc\nfoo" prop_readHereDoc9 = isOk readScript "if true; then cat << foo; fi\nbar\nfoo\n" -prop_readHereDoc10= isOk readScript "if true; then cat << foo << bar; fi\nfoo\nbar\n" -prop_readHereDoc11= isOk readScript "cat << foo $(\nfoo\n)lol\nfoo\n" -prop_readHereDoc12= isOk readScript "cat << foo|cat\nbar\nfoo" -prop_readHereDoc13= isOk readScript "cat <<'#!'\nHello World\n#!\necho Done" -prop_readHereDoc14= isWarning readScript "cat << foo\nbar\nfoo \n" -prop_readHereDoc15= isWarning readScript "cat < Date: Fri, 22 Jul 2022 17:06:24 -0700 Subject: [PATCH 033/244] Omit SC3021 about `>& file` unless definitely non-numeric (fixes #2520) --- src/ShellCheck/Checks/ShellSupport.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index c12da2d..30a19b9 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -135,6 +135,8 @@ prop_checkBashisms49 = verify checkBashisms "#!/bin/dash\necho $MACHTYPE" prop_checkBashisms50 = verify checkBashisms "#!/bin/sh\ncmd >& file" prop_checkBashisms51 = verifyNot checkBashisms "#!/bin/sh\ncmd 2>&1" prop_checkBashisms52 = verifyNot checkBashisms "#!/bin/sh\ncmd >&2" +prop_checkBashisms52b = verifyNot checkBashisms "#!/bin/sh\ncmd >& $var" +prop_checkBashisms52c = verify checkBashisms "#!/bin/sh\ncmd >& $dir/$var" prop_checkBashisms53 = verifyNot checkBashisms "#!/bin/sh\nprintf -- -f\n" prop_checkBashisms54 = verify checkBashisms "#!/bin/sh\nfoo+=bar" prop_checkBashisms55 = verify checkBashisms "#!/bin/sh\necho ${@%foo}" @@ -225,7 +227,8 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do warnMsg id 3018 $ filter (/= '|') op ++ " is" bashism (TA_Binary id "**" _ _) = warnMsg id 3019 "exponentials are" bashism (T_FdRedirect id "&" (T_IoFile _ (T_Greater _) _)) = warnMsg id 3020 "&> is" - bashism (T_FdRedirect id "" (T_IoFile _ (T_GREATAND _) _)) = warnMsg id 3021 ">& is" + bashism (T_FdRedirect id "" (T_IoFile _ (T_GREATAND _) file)) = + unless (all isDigit $ onlyLiteralString file) $ warnMsg id 3021 ">& filename (as opposed to >& fd) is" bashism (T_FdRedirect id ('{':_) _) = warnMsg id 3022 "named file descriptors are" bashism (T_FdRedirect id num _) | all isDigit num && length num > 1 = warnMsg id 3023 "FDs outside 0-9 are" From b261ec24f9ebcb911e7ff4264e5ea7d36cc93f59 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 22 Jul 2022 20:16:01 -0700 Subject: [PATCH 034/244] Include exit codes in DFA (ref #2541) --- src/ShellCheck/CFG.hs | 8 ++- src/ShellCheck/CFGAnalysis.hs | 92 +++++++++++++++++++++++++++-------- 2 files changed, 77 insertions(+), 23 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index 4906d80..1085d8f 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -651,7 +651,10 @@ build t = do pg <- wordToExactPseudoGlob c return $ pg `pseudoGlobIsSuperSetof` [PGMany] - T_Condition _ _ op -> build op + T_Condition id _ op -> do + cond <- build op + status <- newNodeRange $ CFSetExitCode id + linkRange cond status T_CoProc id maybeName t -> do let name = fromMaybe "COPROC" maybeName @@ -798,7 +801,8 @@ build t = do start <- newStructuralNode hasLastpipe <- reader $ cfLastpipe . cfParameters (leading, last) <- buildPipe hasLastpipe cmds - end <- newStructuralNode + -- Ideally we'd let this exit code be that of the last command in the pipeline but ok + end <- newNodeRange $ CFSetExitCode id mapM_ (linkRange start) leading mapM_ (\c -> linkRangeAs CFEFalseFlow c end) leading diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index daade43..893c34a 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -104,11 +104,29 @@ data CFGAnalysis = CFGAnalysis { -- The program state we expose externally data ProgramState = ProgramState { --- internalState :: InternalState, -- For debugging + -- internalState :: InternalState, -- For debugging variablesInScope :: M.Map String VariableState, + exitCodes :: S.Set Id, stateIsReachable :: Bool } deriving (Show, Eq, Generic, NFData) +internalToExternal :: InternalState -> ProgramState +internalToExternal s = + ProgramState { + -- Censor the literal value to avoid introducing dependencies on it. It's just for debugging. + variablesInScope = M.map censor flatVars, + -- internalState = s, -- For debugging + exitCodes = fromMaybe S.empty $ sExitCodes s, + stateIsReachable = fromMaybe True $ sIsReachable s + } + where + censor s = s { + variableValue = (variableValue s) { + literalValue = Nothing + } + } + flatVars = M.unionsWith (\_ last -> last) $ map mapStorage [sGlobalValues s, sLocalValues s, sPrefixValues s] + -- Conveniently get the state before a token id getIncomingState :: CFGAnalysis -> Id -> Maybe ProgramState getIncomingState analysis id = do @@ -130,6 +148,7 @@ data InternalState = InternalState { sLocalValues :: VersionedMap String VariableState, sPrefixValues :: VersionedMap String VariableState, sFunctionTargets :: VersionedMap String FunctionValue, + sExitCodes :: Maybe (S.Set Id), sIsReachable :: Maybe Bool } deriving (Show, Generic, NFData) @@ -139,6 +158,7 @@ newInternalState = InternalState { sLocalValues = vmEmpty, sPrefixValues = vmEmpty, sFunctionTargets = vmEmpty, + sExitCodes = Nothing, sIsReachable = Nothing } @@ -196,31 +216,25 @@ removeProperties props state = state { variableProperties = S.map (\s -> S.difference s props) $ variableProperties state } -internalToExternal :: InternalState -> ProgramState -internalToExternal s = - ProgramState { - -- Censor the literal value to avoid introducing dependencies on it. It's just for debugging. - variablesInScope = M.map censor flatVars, - -- internalState = s, -- For debugging - stateIsReachable = fromMaybe True $ sIsReachable s - } - where - censor s = s { - variableValue = (variableValue s) { - literalValue = Nothing - } - } - flatVars = M.unionsWith (\_ last -> last) $ map mapStorage [sGlobalValues s, sLocalValues s, sPrefixValues s] +setExitCode id = setExitCodes (S.singleton id) +setExitCodes set state = modified state { + sExitCodes = Just $ set +} -- Dependencies on values, e.g. "if there is a global variable named 'foo' without spaces" -- This is used to see if the DFA of a function would result in the same state, so anything -- that affects DFA must be tracked. data StateDependency = + -- Complete variable state DepState Scope String VariableState + -- Only variable properties (we need properties but not values for x=1) | DepProperties Scope String VariableProperties + -- Function definition | DepFunction String (S.Set FunctionDefinition) -- Whether invoking the node would result in recursion (i.e., is the function on the stack?) | DepIsRecursive Node Bool + -- The set of commands that could have provided the exit code $? + | DepExitCodes (S.Set Id) deriving (Show, Eq, Ord, Generic, NFData) -- A function definition, or lack thereof @@ -242,6 +256,7 @@ depsToState set = foldl insert newInternalState $ S.toList set -- State includes properties and more, so don't overwrite a state with properties DepProperties scope name props -> insertIn False scope name unknownVariableState { variableProperties = props } state DepIsRecursive _ _ -> state + DepExitCodes s -> setExitCodes s state insertIn overwrite scope name val state = let @@ -400,6 +415,7 @@ patchState base diff = sLocalValues = vmPatch (sLocalValues base) (sLocalValues diff), sPrefixValues = vmPatch (sPrefixValues base) (sPrefixValues diff), sFunctionTargets = vmPatch (sFunctionTargets base) (sFunctionTargets diff), + sExitCodes = sExitCodes diff `mplus` sExitCodes base, sIsReachable = sIsReachable diff `mplus` sIsReachable base } @@ -444,12 +460,14 @@ mergeState ctx a b = do locals <- mergeMaps ctx mergeVariableState readVariable (sLocalValues a) (sLocalValues b) prefix <- mergeMaps ctx mergeVariableState readVariable (sPrefixValues a) (sPrefixValues b) funcs <- mergeMaps ctx S.union readFunction (sFunctionTargets a) (sFunctionTargets b) + exitCodes <- mergeMaybes ctx S.union readExitCodes (sExitCodes a) (sExitCodes b) return $ InternalState { sVersion = -1, sGlobalValues = globals, sLocalValues = locals, sPrefixValues = prefix, sFunctionTargets = funcs, + sExitCodes = exitCodes, sIsReachable = liftM2 (&&) (sIsReachable a) (sIsReachable b) } @@ -493,6 +511,18 @@ mergeMaps ctx merger reader a b = nv1 <- reader ctx k2 f ((k2, merger nv1 v2):l) l1 rest2 +-- Merge two Maybes, like mergeMaps for a single element +mergeMaybes ctx merger reader a b = + case (a, b) of + (Nothing, Nothing) -> return Nothing + (Just v1, Nothing) -> single v1 + (Nothing, Just v2) -> single v2 + (Just v1, Just v2) -> return $ Just $ merger v1 v2 + where + single val = do + result <- merger val <$> reader ctx + return $ Just result + vmFromMap ctx map = return $ VersionedMap { mapVersion = -1, mapStorage = map @@ -708,6 +738,12 @@ readFunction ctx name = lookupStack get dep def ctx name writeFunction ctx name val = do modifySTRef (cOutput ctx) $ insertFunction name $ S.singleton val +readExitCodes ctx = lookupStack get dep def ctx () + where + get s () = sExitCodes s + def = S.empty + dep () v = DepExitCodes v + -- Look up each state on the stack until a value is found (or the default is used), -- then add this value as a StateDependency. lookupStack' :: forall s k v. @@ -872,13 +908,13 @@ transfer ctx label = CFExecuteCommand cmd -> transferCommand ctx cmd CFExecuteSubshell reason entry exit -> transferSubshell ctx reason entry exit CFApplyEffects effects -> mapM_ (\(IdTagged _ f) -> transferEffect ctx f) effects + CFSetExitCode id -> transferExitCode ctx id CFUnresolvedExit -> patchOutputM ctx unreachableState CFUnreachable -> patchOutputM ctx unreachableState -- TODO CFSetBackgroundPid _ -> return () - CFSetExitCode _ -> return () CFDropPrefixAssignments {} -> modifySTRef (cOutput ctx) $ \c -> modified c { sPrefixValues = vmEmpty } -- _ -> error $ "Unknown " ++ show label @@ -891,8 +927,11 @@ transferSubshell ctx reason entry exit = do let cout = cOutput ctx initial <- readSTRef cout runCached ctx entry (f entry exit) + res <- readSTRef cout -- Clear subshell changes. TODO: track this to warn about modifications. - writeSTRef cout initial + writeSTRef cout $ initial { + sExitCodes = sExitCodes res + } where f entry exit ctx = do (states, frame) <- withNewStackFrame ctx entry False (flip dataflow $ entry) @@ -947,6 +986,8 @@ transferFunctionValue ctx funcVal = registerFlowResult ctx entry states deps return (deps, res) +transferExitCode ctx id = do + modifySTRef (cOutput ctx) $ setExitCode id -- Register/save the result of a dataflow of a function. -- At the end, all the different values from different flows are merged together. @@ -1001,8 +1042,10 @@ getCache ctx node = do -- Transfer a single CFEffect to the output state. transferEffect ctx effect = case effect of - CFReadVariable name -> do - void $ readVariable ctx name + CFReadVariable name -> + case name of + "?" -> void $ readExitCodes ctx + _ -> void $ readVariable ctx name CFWriteVariable name value -> do val <- cfValueToVariableValue ctx value updateVariableValue ctx name val @@ -1235,7 +1278,14 @@ analyzeControlFlow params t = -- (it's probably not actually dead, just used by a script that sources ours) let declaredFunctions = getFunctionTargets exitState let uninvoked = M.difference declaredFunctions invokedNodes - analyzeStragglers ctx exitState uninvoked + + let stragglerInput = + exitState { + -- We don't want `die() { exit $?; }; echo "Sourced"` to assume $? is always echo + sExitCodes = Nothing + } + + analyzeStragglers ctx stragglerInput uninvoked -- Now round up all the states from all data flows -- (FIXME: this excludes functions that were defined in straggling functions) From f7857028f7a019b47c8a5294dd8d4182e5bed864 Mon Sep 17 00:00:00 2001 From: ygeyzel Date: Sat, 23 Jul 2022 19:24:16 +0300 Subject: [PATCH 035/244] Add escape characters to SC2028: \a, \b, \e, \f, \v, \\, \', \OOO, \xHH --- src/ShellCheck/Checks/Commands.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 4bae17e..67c3c48 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -481,9 +481,16 @@ prop_checkUnusedEchoEscapes2 = verifyNot checkUnusedEchoEscapes "echo -e 'foi\\n prop_checkUnusedEchoEscapes3 = verify checkUnusedEchoEscapes "echo \"n:\\t42\"" prop_checkUnusedEchoEscapes4 = verifyNot checkUnusedEchoEscapes "echo lol" prop_checkUnusedEchoEscapes5 = verifyNot checkUnusedEchoEscapes "echo -n -e '\n'" +prop_checkUnusedEchoEscapes6 = verify checkUnusedEchoEscapes "echo '\\506'" +prop_checkUnusedEchoEscapes7 = verify checkUnusedEchoEscapes "echo '\\5a'" +prop_checkUnusedEchoEscapes8 = verifyNot checkUnusedEchoEscapes "echo '\\8a'" +prop_checkUnusedEchoEscapes9 = verifyNot checkUnusedEchoEscapes "echo '\\d5a'" +prop_checkUnusedEchoEscapes10 = verify checkUnusedEchoEscapes "echo '\\x4a'" +prop_checkUnusedEchoEscapes11 = verify checkUnusedEchoEscapes "echo '\\xat'" +prop_checkUnusedEchoEscapes12 = verifyNot checkUnusedEchoEscapes "echo '\\xth'" checkUnusedEchoEscapes = CommandCheck (Basename "echo") f where - hasEscapes = mkRegex "\\\\[rnt]" + hasEscapes = mkRegex "\\\\([rntabefv\\']|[0-7]{1,3}|x([0-9]|[A-F]|[a-f]){1,2})" f cmd = whenShell [Sh, Bash, Ksh] $ unless (cmd `hasFlag` "e") $ From 5cf6e01ce902421065d8eee24c7a4a10d842efa9 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 23 Jul 2022 09:38:58 -0700 Subject: [PATCH 036/244] Warn when $? refers to echo or condition (ref #2541) --- CHANGELOG.md | 1 + src/ShellCheck/Analytics.hs | 37 +++++++++++++++++++++++++++++++++++ src/ShellCheck/AnalyzerLib.hs | 3 +++ src/ShellCheck/CFGAnalysis.hs | 1 + 4 files changed, 42 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index dce3e27..5ff01c3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,7 @@ - SC2316: Warn about 'local readonly foo' and similar (thanks, patrickxia!) - SC2317: Warn about unreachable commands - SC2318: Warn about backreferences in 'declare x=1 y=$x' +- SC2319/SC2320: Warn when $? refers to echo/printf/[ ]/[[ ]]/test ### Fixed - SC2086: Now uses DFA to make more accurate predictions about values diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 1429e1b..07bf25b 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -205,6 +205,7 @@ nodeChecks = [ ,checkBatsTestDoesNotUseNegation ,checkCommandIsUnreachable ,checkSpacefulnessCfg + ,checkOverwrittenExitCode ] optionalChecks = map fst optionalTreeChecks @@ -4876,5 +4877,41 @@ checkCommandIsUnreachable params t = _ -> return () where id = getId t + +prop_checkOverwrittenExitCode1 = verify checkOverwrittenExitCode "x; [ $? -eq 1 ] || [ $? -eq 2 ]" +prop_checkOverwrittenExitCode2 = verifyNot checkOverwrittenExitCode "x; [ $? -eq 1 ]" +prop_checkOverwrittenExitCode3 = verify checkOverwrittenExitCode "x; echo \"Exit is $?\"; [ $? -eq 0 ]" +prop_checkOverwrittenExitCode4 = verifyNot checkOverwrittenExitCode "x; [ $? -eq 0 ]" +checkOverwrittenExitCode params t = + case t of + T_DollarBraced id _ val | getLiteralString val == Just "?" -> check id + _ -> return () + where + check id = sequence_ $ do + state <- CF.getIncomingState (cfgAnalysis params) id + let exitCodeIds = CF.exitCodes state + guard . not $ S.null exitCodeIds + + let idToToken = idMap params + exitCodeTokens <- sequence $ map (\k -> Map.lookup k idToToken) $ S.toList exitCodeIds + return $ do + when (all isCondition exitCodeTokens) $ + warn id 2319 "This $? refers to a condition, not a command. Assign to a variable to avoid it being overwritten." + when (all isPrinting exitCodeTokens) $ + warn id 2320 "This $? refers to echo/printf, not a previous command. Assign to variable to avoid it being overwritten." + + isCondition t = + case t of + T_Condition {} -> True + T_SimpleCommand {} -> getCommandName t == Just "test" + _ -> False + + isPrinting t = + case getCommandBasename t of + Just "echo" -> True + Just "printf" -> True + _ -> False + + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index e998f2c..88da89e 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -89,6 +89,8 @@ data Parameters = Parameters { hasPipefail :: Bool, -- A linear (bad) analysis of data flow variableFlow :: [StackData], + -- A map from Id to Token + idMap :: Map.Map Id Token, -- A map from Id to parent Token parentMap :: Map.Map Id Token, -- The shell type, such as Bash or Ksh @@ -218,6 +220,7 @@ makeParameters spec = params Sh -> True Ksh -> containsPipefail root, shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec), + idMap = getTokenMap root, parentMap = getParentTree root, variableFlow = getVariableFlow params root, tokenPositions = asTokenPositions spec, diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 893c34a..bb90860 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -804,6 +804,7 @@ fulfillsDependency ctx entry dep = -- it won't be found by the normal check. DepIsRecursive node val | node == entry -> return True DepIsRecursive node val -> return $ val == any (\f -> entryPoint f == node) (cStack ctx) + DepExitCodes val -> (== val) <$> peekStack (\s k -> sExitCodes s) S.empty ctx () -- _ -> error $ "Unknown dep " ++ show dep where peek scope = peekStack getVariableWithScope $ if scope == GlobalScope then (unknownVariableState, GlobalScope) else (unsetVariableState, LocalScope) From ea4e0091c7b403ace135eddf1e508ff2fc0f783f Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 23 Jul 2022 15:38:42 -0700 Subject: [PATCH 037/244] Additionally pluralize 'arguments' in SC2183 --- src/ShellCheck/Checks/Commands.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 8bca2ba..e97ecd6 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -706,8 +706,8 @@ checkPrintfVar = CommandCheck (Exactly "printf") (f . arguments) where return () -- Great: a suitable number of arguments | otherwise -> warn (getId format) 2183 $ - "This format string has " ++ show formatCount ++ " " ++ (pluraliseIfMany "variable" formatCount) ++ - ", but is passed " ++ show argCount ++ " arguments." + "This format string has " ++ show formatCount ++ " " ++ pluraliseIfMany "variable" formatCount ++ + ", but is passed " ++ show argCount ++ pluraliseIfMany " argument" argCount ++ "." unless ('%' `elem` concat (oversimplify format) || isLiteral format) $ info (getId format) 2059 From 30bb0e0093172b93fecb53dca9d5d657962d8c0a Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 23 Jul 2022 20:10:58 -0700 Subject: [PATCH 038/244] SC2321: Warn about redundant $(()) in arr[$((i))]=x (ref: #1666) --- CHANGELOG.md | 1 + src/ShellCheck/Analytics.hs | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5ff01c3..669579f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,7 @@ - SC2317: Warn about unreachable commands - SC2318: Warn about backreferences in 'declare x=1 y=$x' - SC2319/SC2320: Warn when $? refers to echo/printf/[ ]/[[ ]]/test +- SC2321: Suggest removing $((..)) in array[$((idx))]=val ### Fixed - SC2086: Now uses DFA to make more accurate predictions about values diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 07bf25b..e92f3ff 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -206,6 +206,7 @@ nodeChecks = [ ,checkCommandIsUnreachable ,checkSpacefulnessCfg ,checkOverwrittenExitCode + ,checkUnnecessaryArithmeticExpansionIndex ] optionalChecks = map fst optionalTreeChecks @@ -4913,5 +4914,22 @@ checkOverwrittenExitCode params t = _ -> False +prop_checkUnnecessaryArithmeticExpansionIndex1 = verify checkUnnecessaryArithmeticExpansionIndex "a[$((1+1))]=n" +prop_checkUnnecessaryArithmeticExpansionIndex2 = verifyNot checkUnnecessaryArithmeticExpansionIndex "a[1+1]=n" +prop_checkUnnecessaryArithmeticExpansionIndex3 = verifyNot checkUnnecessaryArithmeticExpansionIndex "a[$(echo $((1+1)))]=n" +checkUnnecessaryArithmeticExpansionIndex params t = + case t of + T_Assignment _ mode var [TA_Sequence _ [ TA_Expansion _ [expansion@(T_DollarArithmetic id _)]]] val -> + styleWithFix id 2321 "Array indices are already arithmetic contexts. Prefer removing the $(( and ))." $ fix id + _ -> return () + + where + fix id = + fixWith [ + replaceStart id params 3 "", -- Remove "$((" + replaceEnd id params 2 "" -- Remove "))" + ] + + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) From 52dac51cd4d919667e3a2d3d3feec1d516464392 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 24 Jul 2022 14:06:01 -0700 Subject: [PATCH 039/244] SC2323: Warn about redundant parens in a[(x+1)] and $(( ((x)) )) (ref: #1666) --- CHANGELOG.md | 2 ++ src/ShellCheck/AST.hs | 4 +++- src/ShellCheck/Analytics.hs | 33 +++++++++++++++++++++++++++++++++ src/ShellCheck/CFG.hs | 1 + src/ShellCheck/Parser.hs | 4 +++- 5 files changed, 42 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 669579f..cef16f4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,8 @@ - SC2318: Warn about backreferences in 'declare x=1 y=$x' - SC2319/SC2320: Warn when $? refers to echo/printf/[ ]/[[ ]]/test - SC2321: Suggest removing $((..)) in array[$((idx))]=val +- SC2322: Suggest collapsing double parentheses in arithmetic contexts +- SC2323: Suggest removing wrapping parentheses in a[(x+1)]=val ### Fixed - SC2086: Now uses DFA to make more accurate predictions about values diff --git a/src/ShellCheck/AST.hs b/src/ShellCheck/AST.hs index 2cd2f6f..ca5007a 100644 --- a/src/ShellCheck/AST.hs +++ b/src/ShellCheck/AST.hs @@ -45,6 +45,7 @@ data InnerToken t = | Inner_TA_Variable String [t] | Inner_TA_Expansion [t] | Inner_TA_Sequence [t] + | Inner_TA_Parenthesis t | Inner_TA_Trinary t t t | Inner_TA_Unary String t | Inner_TC_And ConditionType String t t @@ -204,6 +205,7 @@ pattern T_Annotation id anns t = OuterToken id (Inner_T_Annotation anns t) pattern T_Arithmetic id c = OuterToken id (Inner_T_Arithmetic c) pattern T_Array id t = OuterToken id (Inner_T_Array t) pattern TA_Sequence id l = OuterToken id (Inner_TA_Sequence l) +pattern TA_Parentesis id t = OuterToken id (Inner_TA_Parenthesis t) pattern T_Assignment id mode var indices value = OuterToken id (Inner_T_Assignment mode var indices value) pattern TA_Trinary id t1 t2 t3 = OuterToken id (Inner_TA_Trinary t1 t2 t3) pattern TA_Unary id op t1 = OuterToken id (Inner_TA_Unary op t1) @@ -256,7 +258,7 @@ pattern T_Subshell id l = OuterToken id (Inner_T_Subshell l) pattern T_UntilExpression id c l = OuterToken id (Inner_T_UntilExpression c l) pattern T_WhileExpression id c l = OuterToken id (Inner_T_WhileExpression c l) -{-# COMPLETE T_AND_IF, T_Bang, T_Case, TC_Empty, T_CLOBBER, T_DGREAT, T_DLESS, T_DLESSDASH, T_Do, T_DollarSingleQuoted, T_Done, T_DSEMI, T_Elif, T_Else, T_EOF, T_Esac, T_Fi, T_For, T_Glob, T_GREATAND, T_Greater, T_If, T_In, T_Lbrace, T_Less, T_LESSAND, T_LESSGREAT, T_Literal, T_Lparen, T_NEWLINE, T_OR_IF, T_ParamSubSpecialChar, T_Pipe, T_Rbrace, T_Rparen, T_Select, T_Semi, T_SingleQuoted, T_Then, T_UnparsedIndex, T_Until, T_While, TA_Assignment, TA_Binary, TA_Expansion, T_AndIf, T_Annotation, T_Arithmetic, T_Array, TA_Sequence, T_Assignment, TA_Trinary, TA_Unary, TA_Variable, T_Backgrounded, T_Backticked, T_Banged, T_BatsTest, T_BraceExpansion, T_BraceGroup, TC_And, T_CaseExpression, TC_Binary, TC_Group, TC_Nullary, T_Condition, T_CoProcBody, T_CoProc, TC_Or, TC_Unary, T_DollarArithmetic, T_DollarBraceCommandExpansion, T_DollarBraced, T_DollarBracket, T_DollarDoubleQuoted, T_DollarExpansion, T_DoubleQuoted, T_Extglob, T_FdRedirect, T_ForArithmetic, T_ForIn, T_Function, T_HereDoc, T_HereString, T_IfExpression, T_Include, T_IndexedElement, T_IoDuplicate, T_IoFile, T_NormalWord, T_OrIf, T_Pipeline, T_ProcSub, T_Redirecting, T_Script, T_SelectIn, T_SimpleCommand, T_SourceCommand, T_Subshell, T_UntilExpression, T_WhileExpression #-} +{-# COMPLETE T_AND_IF, T_Bang, T_Case, TC_Empty, T_CLOBBER, T_DGREAT, T_DLESS, T_DLESSDASH, T_Do, T_DollarSingleQuoted, T_Done, T_DSEMI, T_Elif, T_Else, T_EOF, T_Esac, T_Fi, T_For, T_Glob, T_GREATAND, T_Greater, T_If, T_In, T_Lbrace, T_Less, T_LESSAND, T_LESSGREAT, T_Literal, T_Lparen, T_NEWLINE, T_OR_IF, T_ParamSubSpecialChar, T_Pipe, T_Rbrace, T_Rparen, T_Select, T_Semi, T_SingleQuoted, T_Then, T_UnparsedIndex, T_Until, T_While, TA_Assignment, TA_Binary, TA_Expansion, T_AndIf, T_Annotation, T_Arithmetic, T_Array, TA_Sequence, TA_Parentesis, T_Assignment, TA_Trinary, TA_Unary, TA_Variable, T_Backgrounded, T_Backticked, T_Banged, T_BatsTest, T_BraceExpansion, T_BraceGroup, TC_And, T_CaseExpression, TC_Binary, TC_Group, TC_Nullary, T_Condition, T_CoProcBody, T_CoProc, TC_Or, TC_Unary, T_DollarArithmetic, T_DollarBraceCommandExpansion, T_DollarBraced, T_DollarBracket, T_DollarDoubleQuoted, T_DollarExpansion, T_DoubleQuoted, T_Extglob, T_FdRedirect, T_ForArithmetic, T_ForIn, T_Function, T_HereDoc, T_HereString, T_IfExpression, T_Include, T_IndexedElement, T_IoDuplicate, T_IoFile, T_NormalWord, T_OrIf, T_Pipeline, T_ProcSub, T_Redirecting, T_Script, T_SelectIn, T_SimpleCommand, T_SourceCommand, T_Subshell, T_UntilExpression, T_WhileExpression #-} instance Eq Token where OuterToken _ a == OuterToken _ b = a == b diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e92f3ff..eed2d25 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -207,6 +207,7 @@ nodeChecks = [ ,checkSpacefulnessCfg ,checkOverwrittenExitCode ,checkUnnecessaryArithmeticExpansionIndex + ,checkUnnecessaryParens ] optionalChecks = map fst optionalTreeChecks @@ -3280,6 +3281,7 @@ checkReturnAgainstZero params token = _:next@(TA_Unary _ "!" _):_ -> isOnlyTestInCommand next _:next@(TC_Group {}):_ -> isOnlyTestInCommand next _:next@(TA_Sequence _ [_]):_ -> isOnlyTestInCommand next + _:next@(TA_Parentesis _ _):_ -> isOnlyTestInCommand next _ -> False -- TODO: Do better $? tracking and filter on whether @@ -4931,5 +4933,36 @@ checkUnnecessaryArithmeticExpansionIndex params t = ] +prop_checkUnnecessaryParens1 = verify checkUnnecessaryParens "echo $(( ((1+1)) ))" +prop_checkUnnecessaryParens2 = verify checkUnnecessaryParens "x[((1+1))+1]=1" +prop_checkUnnecessaryParens3 = verify checkUnnecessaryParens "x[(1+1)]=1" +prop_checkUnnecessaryParens4 = verify checkUnnecessaryParens "$(( (x) ))" +prop_checkUnnecessaryParens5 = verify checkUnnecessaryParens "(( (x) ))" +prop_checkUnnecessaryParens6 = verifyNot checkUnnecessaryParens "x[(1+1)+1]=1" +prop_checkUnnecessaryParens7 = verifyNot checkUnnecessaryParens "(( (1*1)+1 ))" +prop_checkUnnecessaryParens8 = verifyNot checkUnnecessaryParens "(( (1)+1 ))" +checkUnnecessaryParens params t = + case t of + T_DollarArithmetic _ t -> checkLeading "$(( (x) )) is the same as $(( x ))" t + T_ForArithmetic _ x y z _ -> mapM_ (checkLeading "for (((x); (y); (z))) is the same as for ((x; y; z))") [x,y,z] + T_Assignment _ _ _ [t] _ -> checkLeading "a[(x)] is the same as a[x]" t + T_Arithmetic _ t -> checkLeading "(( (x) )) is the same as (( x ))" t + TA_Parentesis _ (TA_Sequence _ [ TA_Parentesis id _ ]) -> + styleWithFix id 2322 "In arithmetic contexts, ((x)) is the same as (x). Prefer only one layer of parentheses." $ fix id + _ -> return () + where + + checkLeading str t = + case t of + TA_Sequence _ [TA_Parentesis id _ ] -> styleWithFix id 2323 (str ++ ". Prefer not wrapping in additional parentheses.") $ fix id + _ -> return () + + fix id = + fixWith [ + replaceStart id params 1 "", -- Remove "(" + replaceEnd id params 1 "" -- Remove ")" + ] + + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index 1085d8f..6f6d4f1 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -479,6 +479,7 @@ build t = do TA_Binary _ _ a b -> sequentially [a,b] TA_Expansion _ list -> sequentially list TA_Sequence _ list -> sequentially list + TA_Parentesis _ t -> build t TA_Trinary _ cond a b -> do condition <- build cond diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index e6a2999..0dd6621 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -821,11 +821,13 @@ readArithmeticContents = return $ TA_Expansion id pieces readGroup = do + start <- startSpan char '(' s <- readSequence char ')' + id <- endSpan start spacing - return s + return $ TA_Parentesis id s readArithTerm = readGroup <|> readVariable <|> readExpansion From 982681fc05ca8db887431691d1cc40633e20d828 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 24 Jul 2022 14:30:31 -0700 Subject: [PATCH 040/244] Add unit test to ensure SC2321 does not trigger on associative arrays --- src/ShellCheck/Analytics.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index eed2d25..8499d8d 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4919,6 +4919,7 @@ checkOverwrittenExitCode params t = prop_checkUnnecessaryArithmeticExpansionIndex1 = verify checkUnnecessaryArithmeticExpansionIndex "a[$((1+1))]=n" prop_checkUnnecessaryArithmeticExpansionIndex2 = verifyNot checkUnnecessaryArithmeticExpansionIndex "a[1+1]=n" prop_checkUnnecessaryArithmeticExpansionIndex3 = verifyNot checkUnnecessaryArithmeticExpansionIndex "a[$(echo $((1+1)))]=n" +prop_checkUnnecessaryArithmeticExpansionIndex4 = verifyNot checkUnnecessaryArithmeticExpansionIndex "declare -A a; a[$((1+1))]=val" checkUnnecessaryArithmeticExpansionIndex params t = case t of T_Assignment _ mode var [TA_Sequence _ [ TA_Expansion _ [expansion@(T_DollarArithmetic id _)]]] val -> From f1148b8b41087dba8441a2c79980441522e3b23b Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 25 Jul 2022 10:00:50 -0700 Subject: [PATCH 041/244] Include postdominators in CFGResult --- src/ShellCheck/CFG.hs | 86 ++++++++++++++++++++++++++++++++--- src/ShellCheck/CFGAnalysis.hs | 5 +- 2 files changed, 84 insertions(+), 7 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index 6f6d4f1..ad05e93 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -54,6 +54,8 @@ import qualified Data.Set as S import Control.Monad.RWS.Lazy import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Query.DFS +import Data.Graph.Inductive.Basic +import Data.Graph.Inductive.Query.Dominators import Data.Graph.Inductive.PatriciaTree as G import Debug.Trace -- STRIP @@ -171,9 +173,11 @@ data CFGResult = CFGResult { -- Map from Id to nominal start&end node (i.e. assuming normal execution without exits) cfIdToRange :: M.Map Id (Node, Node), -- A set of all nodes belonging to an Id, recursively - cfIdToNodes :: M.Map Id (S.Set Node) + cfIdToNodes :: M.Map Id (S.Set Node), + -- A map to nodes that the given node postdominates + cfPostDominators :: M.Map Node (S.Set Node) } - deriving (Show) + deriving (Show, Generic, NFData) buildGraph :: CFGParameters -> Token -> CFGResult buildGraph params root = @@ -183,12 +187,20 @@ buildGraph params root = -- renumberTopologically $ removeUnnecessaryStructuralNodes base - in - CFGResult { + + idToRange = M.fromList mapping + isRealEdge (from, to, edge) = case edge of CFEFlow -> True; _ -> False + onlyRealEdges = filter isRealEdge edges + (_, mainExit) = fromJust $ M.lookup (getId root) idToRange + + result = CFGResult { cfGraph = mkGraph nodes edges, - cfIdToRange = M.fromList mapping, - cfIdToNodes = M.fromListWith S.union $ map (\(id, n) -> (id, S.singleton n)) association + cfIdToRange = idToRange, + cfIdToNodes = M.fromListWith S.union $ map (\(id, n) -> (id, S.singleton n)) association, + cfPostDominators = findPostDominators mainExit $ mkGraph nodes onlyRealEdges } + in + deepseq result result remapGraph :: M.Map Node Node -> CFW -> CFW remapGraph remap (nodes, edges, mapping, assoc) = @@ -1190,5 +1202,67 @@ tokenToParts t = -- Check if getLiteralString can handle it, if not it's unknown _ -> [maybe CFStringUnknown CFStringLiteral $ getLiteralString t] + +-- Change all subshell invocations to instead link directly to their contents. +-- This is used for producing dominator trees. +inlineSubshells :: CFGraph -> CFGraph +inlineSubshells graph = relinkedGraph + where + subshells = ufold find [] graph + find (incoming, node, label, outgoing) acc = + case label of + CFExecuteSubshell _ start end -> (node, label, start, end, incoming, outgoing):acc + _ -> acc + + relinkedGraph = foldl' relink graph subshells + relink graph (node, label, start, end, incoming, outgoing) = + let + -- Link CFExecuteSubshell to the CFEntryPoint + subshellToStart = (incoming, node, label, [(CFEFlow, start)]) + -- Link the subshell exit to the + endToNexts = (endIncoming, endNode, endLabel, outgoing) + (endIncoming, endNode, endLabel, _) = context graph end + in + subshellToStart & (endToNexts & graph) + +findEntryNodes :: CFGraph -> [Node] +findEntryNodes graph = ufold find [] graph + where + find (incoming, node, label, _) list = + case label of + CFEntryPoint {} | null incoming -> node:list + _ -> list + +findDominators main graph = asSetMap + where + inlined = inlineSubshells graph + entryNodes = main : findEntryNodes graph + asLists = concatMap (dom inlined) entryNodes + asSetMap = M.fromList $ map (\(node, list) -> (node, S.fromList list)) asLists + +findTerminalNodes :: CFGraph -> [Node] +findTerminalNodes graph = ufold find [] graph + where + find (_, node, label, _) list = + case label of + CFUnresolvedExit -> node:list + CFApplyEffects effects -> f effects list + _ -> list + + f [] list = list + f (IdTagged _ (CFDefineFunction _ id start end):rest) list = f rest (end:list) + f (_:rest) list = f rest list + +findPostDominators :: Node -> CFGraph -> M.Map Node (S.Set Node) +findPostDominators mainexit graph = asSetMap + where + inlined = inlineSubshells graph + terminals = findTerminalNodes inlined + (incoming, _, label, outgoing) = context graph mainexit + withExitEdges = (incoming ++ map (\c -> (CFEFlow, c)) terminals, mainexit, label, outgoing) & inlined + reversed = grev withExitEdges + postDoms = dom reversed mainexit + asSetMap = M.fromList $ map (\(node, list) -> (node, S.fromList list)) postDoms + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index bb90860..dc0a4b1 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -99,6 +99,7 @@ data CFGAnalysis = CFGAnalysis { graph :: CFGraph, tokenToRange :: M.Map Id (Node, Node), tokenToNodes :: M.Map Id (S.Set Node), + postDominators :: M.Map Node (S.Set Node), nodeToData :: M.Map Node (ProgramState, ProgramState) } deriving (Show, Generic, NFData) @@ -1304,7 +1305,8 @@ analyzeControlFlow params t = graph = cfGraph cfg, tokenToRange = cfIdToRange cfg, tokenToNodes = cfIdToNodes cfg, - nodeToData = nodeToData + nodeToData = nodeToData, + postDominators = cfPostDominators cfg } @@ -1355,5 +1357,6 @@ analyzeStragglers ctx state stragglers = do transferFunctionValue ctx def + return [] runTests = $quickCheckAll From e9784fa9a77f6f018997f5d164148422f7da0b33 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 25 Jul 2022 11:57:04 -0700 Subject: [PATCH 042/244] Refine #2544 to not warn when $? postdominates [ ] (fixes #2544) --- src/ShellCheck/Analytics.hs | 13 +++++++++++-- src/ShellCheck/CFGAnalysis.hs | 10 ++++++++++ 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 8499d8d..42d5a9e 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4884,7 +4884,11 @@ checkCommandIsUnreachable params t = prop_checkOverwrittenExitCode1 = verify checkOverwrittenExitCode "x; [ $? -eq 1 ] || [ $? -eq 2 ]" prop_checkOverwrittenExitCode2 = verifyNot checkOverwrittenExitCode "x; [ $? -eq 1 ]" prop_checkOverwrittenExitCode3 = verify checkOverwrittenExitCode "x; echo \"Exit is $?\"; [ $? -eq 0 ]" -prop_checkOverwrittenExitCode4 = verifyNot checkOverwrittenExitCode "x; [ $? -eq 0 ]" +prop_checkOverwrittenExitCode4 = verifyNot checkOverwrittenExitCode "x; [ $? -eq 0 ] && echo Success" +prop_checkOverwrittenExitCode5 = verify checkOverwrittenExitCode "x; if [ $? -eq 0 ]; then var=$?; fi" +prop_checkOverwrittenExitCode6 = verify checkOverwrittenExitCode "x; [ $? -gt 0 ] && fail=$?" +prop_checkOverwrittenExitCode7 = verifyNot checkOverwrittenExitCode "[ 1 -eq 2 ]; status=$?" +prop_checkOverwrittenExitCode8 = verifyNot checkOverwrittenExitCode "[ 1 -eq 2 ]; exit $?" checkOverwrittenExitCode params t = case t of T_DollarBraced id _ val | getLiteralString val == Just "?" -> check id @@ -4898,7 +4902,7 @@ checkOverwrittenExitCode params t = let idToToken = idMap params exitCodeTokens <- sequence $ map (\k -> Map.lookup k idToToken) $ S.toList exitCodeIds return $ do - when (all isCondition exitCodeTokens) $ + when (all isCondition exitCodeTokens && not (usedUnconditionally t exitCodeIds)) $ warn id 2319 "This $? refers to a condition, not a command. Assign to a variable to avoid it being overwritten." when (all isPrinting exitCodeTokens) $ warn id 2320 "This $? refers to echo/printf, not a previous command. Assign to variable to avoid it being overwritten." @@ -4909,6 +4913,11 @@ checkOverwrittenExitCode params t = T_SimpleCommand {} -> getCommandName t == Just "test" _ -> False + -- If we don't do anything based on the condition, assume we wanted the condition itself + -- This helps differentiate `x; [ $? -gt 0 ] && exit $?` vs `[ cond ]; exit $?` + usedUnconditionally t testIds = + all (\c -> CF.doesPostDominate (cfgAnalysis params) (getId t) c) testIds + isPrinting t = case getCommandBasename t of Just "echo" -> True diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index dc0a4b1..ff88810 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -56,6 +56,7 @@ module ShellCheck.CFGAnalysis ( ,SpaceStatus (..) ,getIncomingState ,getOutgoingState + ,doesPostDominate ,ShellCheck.CFGAnalysis.runTests -- STRIP ) where @@ -140,6 +141,15 @@ getOutgoingState analysis id = do (start,end) <- M.lookup id $ tokenToRange analysis snd <$> M.lookup end (nodeToData analysis) +-- Conveniently determine whether one node postdominates another, +-- i.e. whether 'target' always unconditionally runs after 'base'. +doesPostDominate :: CFGAnalysis -> Id -> Id -> Bool +doesPostDominate analysis target base = fromMaybe False $ do + (_, baseEnd) <- M.lookup base $ tokenToRange analysis + (targetStart, _) <- M.lookup target $ tokenToRange analysis + postDoms <- M.lookup baseEnd $ postDominators analysis + return $ S.member targetStart postDoms + getDataForNode analysis node = M.lookup node $ nodeToData analysis -- The current state of data flow at a point in the program, potentially as a diff From c57e447c89a9ba64bd717560edbeb2192bb7b92a Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 26 Jul 2022 09:46:07 -0700 Subject: [PATCH 043/244] Correctly discard overlapping fixes in diff output (fixes #2370) --- src/ShellCheck/Formatter/Diff.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/ShellCheck/Formatter/Diff.hs b/src/ShellCheck/Formatter/Diff.hs index 197b3af..15d00d7 100644 --- a/src/ShellCheck/Formatter/Diff.hs +++ b/src/ShellCheck/Formatter/Diff.hs @@ -203,10 +203,9 @@ formatDoc color (DiffDoc name lf regions) = buildFixMap :: [Fix] -> M.Map String Fix buildFixMap fixes = perFile where - splitFixes = concatMap splitFixByFile fixes + splitFixes = splitFixByFile $ mconcat fixes perFile = groupByMap (posFile . repStartPos . head . fixReplacements) splitFixes --- There are currently no multi-file fixes, but let's handle it anyways splitFixByFile :: Fix -> [Fix] splitFixByFile fix = map makeFix $ groupBy sameFile (fixReplacements fix) where From b5f5e6347d59be6b26ce8761646fe95ac7b2f3c7 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 26 Jul 2022 10:42:01 -0700 Subject: [PATCH 044/244] Discard next rather than existing fixes when they overlap --- src/ShellCheck/Fixer.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/ShellCheck/Fixer.hs b/src/ShellCheck/Fixer.hs index 2376842..43a97ab 100644 --- a/src/ShellCheck/Fixer.hs +++ b/src/ShellCheck/Fixer.hs @@ -87,6 +87,7 @@ instance Ranged Replacement where instance Monoid Fix where mempty = newFix mappend = (<>) + mconcat = foldl mappend mempty -- fold left to right since <> discards right on overlap instance Semigroup Fix where f1 <> f2 = From 4a27c9a8d50996438ff4853206be674e28069386 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 26 Jul 2022 15:33:25 -0700 Subject: [PATCH 045/244] Fix overlap check --- src/ShellCheck/Fixer.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Fixer.hs b/src/ShellCheck/Fixer.hs index 43a97ab..358dec9 100644 --- a/src/ShellCheck/Fixer.hs +++ b/src/ShellCheck/Fixer.hs @@ -36,7 +36,7 @@ class Ranged a where end :: a -> Position overlap :: a -> a -> Bool overlap x y = - (yStart >= xStart && yStart < xEnd) || (yStart < xStart && yEnd > xStart) + xEnd > yStart && yEnd > xStart where yStart = start y yEnd = end y From a30ac402eb39d3e60cd3a64abd48d00c85d49bab Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Wed, 27 Jul 2022 11:29:55 -0700 Subject: [PATCH 046/244] Don't use & for updates as result is unspecified This fixes `Prelude.foldl1: empty list []` when script has `( exit )` --- src/ShellCheck/CFG.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index ad05e93..39747cf 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -1203,6 +1203,9 @@ tokenToParts t = _ -> [maybe CFStringUnknown CFStringLiteral $ getLiteralString t] +-- Like & but well defined when the node already exists +safeUpdate ctx@(_,node,_,_) graph = ctx & (delNode node graph) + -- Change all subshell invocations to instead link directly to their contents. -- This is used for producing dominator trees. inlineSubshells :: CFGraph -> CFGraph @@ -1223,7 +1226,7 @@ inlineSubshells graph = relinkedGraph endToNexts = (endIncoming, endNode, endLabel, outgoing) (endIncoming, endNode, endLabel, _) = context graph end in - subshellToStart & (endToNexts & graph) + subshellToStart `safeUpdate` (endToNexts `safeUpdate` graph) findEntryNodes :: CFGraph -> [Node] findEntryNodes graph = ufold find [] graph @@ -1259,7 +1262,7 @@ findPostDominators mainexit graph = asSetMap inlined = inlineSubshells graph terminals = findTerminalNodes inlined (incoming, _, label, outgoing) = context graph mainexit - withExitEdges = (incoming ++ map (\c -> (CFEFlow, c)) terminals, mainexit, label, outgoing) & inlined + withExitEdges = (incoming ++ map (\c -> (CFEFlow, c)) terminals, mainexit, label, outgoing) `safeUpdate` inlined reversed = grev withExitEdges postDoms = dom reversed mainexit asSetMap = M.fromList $ map (\(node, list) -> (node, S.fromList list)) postDoms From 3ce310e939427216e461681e0a71c4883ff5bf03 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Wed, 27 Jul 2022 14:25:19 -0700 Subject: [PATCH 047/244] Plug space leaks when processing multiple files --- shellcheck.hs | 2 +- src/ShellCheck/Formatter/JSON.hs | 3 ++- src/ShellCheck/Formatter/JSON1.hs | 3 ++- src/ShellCheck/Formatter/TTY.hs | 3 ++- 4 files changed, 7 insertions(+), 4 deletions(-) diff --git a/shellcheck.hs b/shellcheck.hs index bf70445..a525251 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -225,7 +225,7 @@ runFormatter sys format options files = do f :: Status -> FilePath -> IO Status f status file = do newStatus <- process file `catch` handler file - return $ status `mappend` newStatus + return $! status `mappend` newStatus handler :: FilePath -> IOException -> IO Status handler file e = reportFailure file (show e) reportFailure file str = do diff --git a/src/ShellCheck/Formatter/JSON.hs b/src/ShellCheck/Formatter/JSON.hs index 7c26421..6b38532 100644 --- a/src/ShellCheck/Formatter/JSON.hs +++ b/src/ShellCheck/Formatter/JSON.hs @@ -23,6 +23,7 @@ module ShellCheck.Formatter.JSON (format) where import ShellCheck.Interface import ShellCheck.Formatter.Format +import Control.DeepSeq import Data.Aeson import Data.IORef import Data.Monoid @@ -103,7 +104,7 @@ collectResult ref cr sys = mapM_ f groups comments = crComments cr groups = groupWith sourceFile comments f :: [PositionedComment] -> IO () - f group = modifyIORef ref (\x -> comments ++ x) + f group = deepseq comments $ modifyIORef ref (\x -> comments ++ x) finish ref = do list <- readIORef ref diff --git a/src/ShellCheck/Formatter/JSON1.hs b/src/ShellCheck/Formatter/JSON1.hs index 54aad34..2169bf6 100644 --- a/src/ShellCheck/Formatter/JSON1.hs +++ b/src/ShellCheck/Formatter/JSON1.hs @@ -23,6 +23,7 @@ module ShellCheck.Formatter.JSON1 (format) where import ShellCheck.Interface import ShellCheck.Formatter.Format +import Control.DeepSeq import Data.Aeson import Data.IORef import Data.Monoid @@ -120,7 +121,7 @@ collectResult ref cr sys = mapM_ f groups result <- siReadFile sys (Just True) filename let contents = either (const "") id result let comments' = makeNonVirtual comments contents - modifyIORef ref (\x -> comments' ++ x) + deepseq comments' $ modifyIORef ref (\x -> comments' ++ x) finish ref = do list <- readIORef ref diff --git a/src/ShellCheck/Formatter/TTY.hs b/src/ShellCheck/Formatter/TTY.hs index 8dd90d4..e28696c 100644 --- a/src/ShellCheck/Formatter/TTY.hs +++ b/src/ShellCheck/Formatter/TTY.hs @@ -23,6 +23,7 @@ import ShellCheck.Fixer import ShellCheck.Interface import ShellCheck.Formatter.Format +import Control.DeepSeq import Control.Monad import Data.Array import Data.Foldable @@ -88,7 +89,7 @@ rankError err = (ranking, cSeverity $ pcComment err, cCode $ pcComment err) appendComments errRef comments max = do previous <- readIORef errRef let current = map (\x -> (rankError x, cCode $ pcComment x, cMessage $ pcComment x)) comments - writeIORef errRef . take max . nubBy equal . sort $ previous ++ current + writeIORef errRef $! force . take max . nubBy equal . sort $ previous ++ current where fst3 (x,_,_) = x equal x y = fst3 x == fst3 y From f4409122799d7967ff843259bc3a51e2fcad2cef Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Wed, 27 Jul 2022 19:47:37 -0700 Subject: [PATCH 048/244] Refactor to not generate Parameters twice --- src/ShellCheck/ASTLib.hs | 4 ++++ src/ShellCheck/Analytics.hs | 39 +++++++++++++++---------------------- src/ShellCheck/Analyzer.hs | 4 ++-- src/ShellCheck/Checker.hs | 5 +++-- 4 files changed, 25 insertions(+), 27 deletions(-) diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 7b4f9e5..56903ee 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -898,6 +898,10 @@ isClosingFileOp op = T_IoDuplicate _ (T_LESSAND _) "-" -> True _ -> False +getEnableDirectives root = + case root of + T_Annotation _ list _ -> [s | EnableComment s <- list] + _ -> [] return [] runTests = $quickCheckAll diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 42d5a9e..e878dc4 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -19,7 +19,7 @@ -} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} -module ShellCheck.Analytics (runAnalytics, optionalChecks, ShellCheck.Analytics.runTests) where +module ShellCheck.Analytics (checker, optionalChecks, ShellCheck.Analytics.runTests) where import ShellCheck.AST import ShellCheck.ASTLib @@ -71,29 +71,22 @@ treeChecks = [ ,checkArrayValueUsedAsIndex ] -runAnalytics :: AnalysisSpec -> [TokenComment] -runAnalytics options = - runList options treeChecks ++ runList options optionalChecks +checker spec params = mkChecker spec params treeChecks + +mkChecker spec params checks = + Checker { + perScript = \(Root root) -> do + tell $ concatMap (\f -> f params root) all, + perToken = const $ return () + } where - root = asScript options - optionals = getEnableDirectives root ++ asOptionalChecks options - optionalChecks = - if "all" `elem` optionals + all = checks ++ optionals + optionalKeys = asOptionalChecks spec + optionals = + if "all" `elem` optionalKeys then map snd optionalTreeChecks - else mapMaybe (\c -> Map.lookup c optionalCheckMap) optionals + else mapMaybe (\c -> Map.lookup c optionalCheckMap) optionalKeys -runList :: AnalysisSpec -> [Parameters -> Token -> [TokenComment]] - -> [TokenComment] -runList spec list = notes - where - root = asScript spec - params = makeParameters spec - notes = concatMap (\f -> f params root) list - -getEnableDirectives root = - case root of - T_Annotation _ list _ -> [s | EnableComment s <- list] - _ -> [] checkList l t = concatMap (\f -> f t) l @@ -318,12 +311,12 @@ producesComments f s = not . null <$> runAndGetComments f s runAndGetComments f s = do let pr = pScript s - prRoot pr + root <- prRoot pr let spec = defaultSpec pr let params = makeParameters spec return $ filterByAnnotation spec params $ - runList spec [f] + f params root -- Copied from https://wiki.haskell.org/Edit_distance dist :: Eq a => [a] -> [a] -> Int diff --git a/src/ShellCheck/Analyzer.hs b/src/ShellCheck/Analyzer.hs index ff2e457..06b6e53 100644 --- a/src/ShellCheck/Analyzer.hs +++ b/src/ShellCheck/Analyzer.hs @@ -35,13 +35,13 @@ analyzeScript :: AnalysisSpec -> AnalysisResult analyzeScript spec = newAnalysisResult { arComments = filterByAnnotation spec params . nub $ - runAnalytics spec - ++ runChecker params (checkers spec params) + runChecker params (checkers spec params) } where params = makeParameters spec checkers spec params = mconcat $ map ($ params) [ + ShellCheck.Analytics.checker spec, ShellCheck.Checks.Commands.checker spec, ShellCheck.Checks.ControlFlow.checker spec, ShellCheck.Checks.Custom.checker, diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index ef8182f..db793f1 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -20,9 +20,10 @@ {-# LANGUAGE TemplateHaskell #-} module ShellCheck.Checker (checkScript, ShellCheck.Checker.runTests) where +import ShellCheck.Analyzer +import ShellCheck.ASTLib import ShellCheck.Interface import ShellCheck.Parser -import ShellCheck.Analyzer import Data.Either import Data.Functor @@ -85,7 +86,7 @@ checkScript sys spec = do asCheckSourced = csCheckSourced spec, asExecutionMode = Executed, asTokenPositions = tokenPositions, - asOptionalChecks = csOptionalChecks spec + asOptionalChecks = getEnableDirectives root ++ csOptionalChecks spec } where as = newAnalysisSpec root let analysisMessages = maybe [] From d0dd81e1faa506232193ad91030dd2cb9f2d4a66 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 28 Jul 2022 08:56:44 -0700 Subject: [PATCH 049/244] Allow quoting values in directives (fixes #2517) --- CHANGELOG.md | 1 + shellcheck.1.md | 3 +++ src/ShellCheck/Checker.hs | 12 ++++++++++++ src/ShellCheck/Parser.hs | 23 +++++++++++++++++------ 4 files changed, 33 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index cef16f4..c363eb5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,7 @@ based on control flow rather than just syntax. Existing checks will gradually start using it, which may cause them to trigger differently (but more accurately). +- Values in directives/shellcheckrc can now be quoted with '' or "" ## v0.8.0 - 2021-11-06 diff --git a/shellcheck.1.md b/shellcheck.1.md index 146d791..c345a2b 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -282,6 +282,9 @@ Here is an example `.shellcheckrc`: source-path=SCRIPTDIR source-path=/mnt/chroot + # Since 0.9.0, values can be quoted with '' or "" to allow spaces + source-path="My Documents/scripts" + # Allow opening any 'source'd file, even if not specified as input external-sources=true diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index db793f1..6518e0d 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -244,6 +244,9 @@ prop_canStripPrefixAndSource2 = prop_canSourceDynamicWhenRedirected = null $ checkWithIncludes [("lib", "")] "#shellcheck source=lib\n. \"$1\"" +prop_canRedirectWithSpaces = + null $ checkWithIncludes [("my file", "")] "#shellcheck source=\"my file\"\n. \"$1\"" + prop_recursiveAnalysis = [2086] == checkRecursive [("lib", "echo $1")] "source lib" @@ -413,6 +416,15 @@ prop_sourcePathAddsAnnotation = result == [2086] csCheckSourced = True } +prop_sourcePathWorksWithSpaces = result == [2086] + where + f "dir/myscript" _ ["my path"] "lib" = return "foo/lib" + result = checkWithIncludesAndSourcePath [("foo/lib", "echo $1")] f emptyCheckSpec { + csScript = "#!/bin/bash\n# shellcheck source-path='my path'\nsource lib", + csFilename = "dir/myscript", + csCheckSourced = True + } + prop_sourcePathRedirectsDirective = result == [2086] where f "dir/myscript" _ _ "lib" = return "foo/lib" diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 0dd6621..4ff45ed 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -992,6 +992,10 @@ prop_readAnnotation5 = isOk readAnnotation "# shellcheck disable=SC2002 # All ca prop_readAnnotation6 = isOk readAnnotation "# shellcheck disable=SC1234 # shellcheck foo=bar\n" prop_readAnnotation7 = isOk readAnnotation "# shellcheck disable=SC1000,SC2000-SC3000,SC1001\n" prop_readAnnotation8 = isOk readAnnotation "# shellcheck disable=all\n" +prop_readAnnotation9 = isOk readAnnotation "# shellcheck source='foo bar' source-path=\"baz etc\"\n" +prop_readAnnotation10 = isOk readAnnotation "# shellcheck disable='SC1234,SC2345' enable=\"foo\" shell='bash'\n" +prop_readAnnotation11 = isOk (readAnnotationWithoutPrefix False) "external-sources='true'" + readAnnotation = called "shellcheck directive" $ do try readAnnotationPrefix many1 linewhitespace @@ -1007,12 +1011,19 @@ readAnnotationWithoutPrefix sandboxed = do many linewhitespace return $ concat values where + plainOrQuoted p = quoted p <|> p + quoted p = do + c <- oneOf "'\"" + start <- getPosition + str <- many1 $ noneOf (c:"\n") + char c <|> fail "Missing terminating quote for directive." + subParse start p str readKey = do keyPos <- getPosition key <- many1 (letter <|> char '-') char '=' <|> fail "Expected '=' after directive key" annotations <- case key of - "disable" -> readElement `sepBy` char ',' + "disable" -> plainOrQuoted $ readElement `sepBy` char ',' where readElement = readRange <|> readAll readAll = do @@ -1027,21 +1038,21 @@ readAnnotationWithoutPrefix sandboxed = do int <- many1 digit return $ read int - "enable" -> readName `sepBy` char ',' + "enable" -> plainOrQuoted $ readName `sepBy` char ',' where readName = EnableComment <$> many1 (letter <|> char '-') "source" -> do - filename <- many1 $ noneOf " \n" + filename <- quoted (many1 anyChar) <|> (many1 $ noneOf " \n") return [SourceOverride filename] "source-path" -> do - dirname <- many1 $ noneOf " \n" + dirname <- quoted (many1 anyChar) <|> (many1 $ noneOf " \n") return [SourcePath dirname] "shell" -> do pos <- getPosition - shell <- many1 $ noneOf " \n" + shell <- quoted (many1 anyChar) <|> (many1 $ noneOf " \n") when (isNothing $ shellForExecutable shell) $ parseNoteAt pos ErrorC 1103 "This shell type is unknown. Use e.g. sh or bash." @@ -1049,7 +1060,7 @@ readAnnotationWithoutPrefix sandboxed = do "external-sources" -> do pos <- getPosition - value <- many1 letter + value <- plainOrQuoted $ many1 letter case value of "true" -> if sandboxed From c76b8d9a327812fe8164e9b667650d0c183978d8 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 28 Jul 2022 09:37:23 -0700 Subject: [PATCH 050/244] Let annotations take effect earlier (fixes #2534) --- src/ShellCheck/Checker.hs | 11 ++++++ src/ShellCheck/Parser.hs | 80 +++++++++++++++++++-------------------- 2 files changed, 49 insertions(+), 42 deletions(-) diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index 6518e0d..c8d2c39 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -496,6 +496,17 @@ prop_fileCannotEnableExternalSources2 = result == [1144] csCheckSourced = True } +prop_rcCanSuppressEarlyProblems1 = null result + where + result = checkWithRc "disable=1071" emptyCheckSpec { + csScript = "#!/bin/zsh\necho $1" + } + +prop_rcCanSuppressEarlyProblems2 = null result + where + result = checkWithRc "disable=1104" emptyCheckSpec { + csScript = "!/bin/bash\necho 'hello world'" + } return [] runTests = $quickCheckAll diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 4ff45ed..d461fc7 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -38,7 +38,6 @@ import Data.Functor import Data.List (isPrefixOf, isInfixOf, isSuffixOf, partition, sortBy, intercalate, nub, find) import Data.Maybe import Data.Monoid -import Debug.Trace -- STRIP import GHC.Exts (sortWith) import Prelude hiding (readList) import System.IO @@ -458,8 +457,8 @@ called s p = do pos <- getPosition withContext (ContextName pos s) p -withAnnotations anns = - withContext (ContextAnnotation anns) +withAnnotations anns p = + if null anns then p else withContext (ContextAnnotation anns) p readConditionContents single = readCondContents `attempting` lookAhead (do @@ -3258,44 +3257,51 @@ prop_readScript3 = isWarning readScript "#!/bin/bash\necho hello\xA0world" prop_readScript4 = isWarning readScript "#!/usr/bin/perl\nfoo=(" prop_readScript5 = isOk readScript "#!/bin/bash\n#This is an empty script\n\n" prop_readScript6 = isOk readScript "#!/usr/bin/env -S X=FOO bash\n#This is an empty script\n\n" +prop_readScript7 = isOk readScript "#!/bin/zsh\n# shellcheck disable=SC1071\nfor f (a b); echo $f\n" readScriptFile sourced = do start <- startSpan pos <- getPosition - optional $ do - readUtf8Bom - parseProblem ErrorC 1082 - "This file has a UTF-8 BOM. Remove it with: LC_CTYPE=C sed '1s/^...//' < yourscript ." - shebang <- readShebang <|> readEmptyLiteral - let (T_Literal _ shebangString) = shebang - allspacing - annotationStart <- startSpan - fileAnnotations <- readAnnotations rcAnnotations <- if sourced then return [] else do filename <- Mr.asks currentFilename readConfigFile filename - let annotations = fileAnnotations ++ rcAnnotations - annotationId <- endSpan annotationStart - let shellAnnotationSpecified = - any (\x -> case x of ShellOverride {} -> True; _ -> False) annotations - shellFlagSpecified <- isJust <$> Mr.asks shellTypeOverride - let ignoreShebang = shellAnnotationSpecified || shellFlagSpecified - unless ignoreShebang $ - verifyShebang pos (executableFromShebang shebangString) - if ignoreShebang || isValidShell (executableFromShebang shebangString) /= Just False - then do - commands <- withAnnotations annotations readCompoundListOrEmpty - id <- endSpan start - verifyEof - let script = T_Annotation annotationId annotations $ - T_Script id shebang commands - reparseIndices script - else do - many anyChar - id <- endSpan start - return $ T_Script id shebang [] + -- Put the rc annotations on the stack so that one can ignore e.g. SC1084 in .shellcheckrc + withAnnotations rcAnnotations $ do + hasBom <- wasIncluded readUtf8Bom + shebang <- readShebang <|> readEmptyLiteral + let (T_Literal _ shebangString) = shebang + allspacing + annotationStart <- startSpan + fileAnnotations <- readAnnotations + + -- Similarly put the filewide annotations on the stack to allow earlier suppression + withAnnotations fileAnnotations $ do + when (hasBom) $ + parseProblemAt pos ErrorC 1082 + "This file has a UTF-8 BOM. Remove it with: LC_CTYPE=C sed '1s/^...//' < yourscript ." + let annotations = fileAnnotations ++ rcAnnotations + annotationId <- endSpan annotationStart + let shellAnnotationSpecified = + any (\x -> case x of ShellOverride {} -> True; _ -> False) annotations + shellFlagSpecified <- isJust <$> Mr.asks shellTypeOverride + let ignoreShebang = shellAnnotationSpecified || shellFlagSpecified + + unless ignoreShebang $ + verifyShebang pos (executableFromShebang shebangString) + if ignoreShebang || isValidShell (executableFromShebang shebangString) /= Just False + then do + commands <- readCompoundListOrEmpty + id <- endSpan start + verifyEof + let script = T_Annotation annotationId annotations $ + T_Script id shebang commands + reparseIndices script + else do + many anyChar + id <- endSpan start + return $ T_Script id shebang [] where verifyShebang pos s = do @@ -3388,16 +3394,6 @@ parsesCleanly parser string = runIdentity $ do return $ Just . null $ parseNotes userState ++ parseProblems systemState (Left _, _) -> return Nothing --- For printf debugging: print the value of an expression --- Example: return $ dump $ T_Literal id [c] -dump :: Show a => a -> a -- STRIP -dump x = trace (show x) x -- STRIP - --- Like above, but print a specific expression: --- Example: return $ dumps ("Returning: " ++ [c]) $ T_Literal id [c] -dumps :: Show x => x -> a -> a -- STRIP -dumps t = trace (show t) -- STRIP - parseWithNotes parser = do item <- parser state <- getState From 04db46381fe515d6e3e66b7d3c33c60fa0275471 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 28 Jul 2022 19:00:03 -0700 Subject: [PATCH 051/244] Use Data.Map.Strict instead for a ~15% parsing speedup --- src/ShellCheck/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index d461fc7..aeaf703 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -46,7 +46,7 @@ import Text.Parsec.Error import Text.Parsec.Pos import qualified Control.Monad.Reader as Mr import qualified Control.Monad.State as Ms -import qualified Data.Map as Map +import qualified Data.Map.Strict as Map import Test.QuickCheck.All (quickCheckAll) From 77069f7445681747ff88eaa56b6bd23b596eee99 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 29 Jul 2022 21:05:33 -0700 Subject: [PATCH 052/244] Store postdominators as Array Node [Node] for a significant win --- src/ShellCheck/CFG.hs | 17 ++++++++++------- src/ShellCheck/CFGAnalysis.hs | 8 ++++---- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index 39747cf..771e870 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -47,6 +47,8 @@ import ShellCheck.Regex import Control.DeepSeq import Control.Monad import Control.Monad.Identity +import Data.Array.Unboxed +import Data.Array.ST import Data.List hiding (map) import Data.Maybe import qualified Data.Map as M @@ -174,10 +176,10 @@ data CFGResult = CFGResult { cfIdToRange :: M.Map Id (Node, Node), -- A set of all nodes belonging to an Id, recursively cfIdToNodes :: M.Map Id (S.Set Node), - -- A map to nodes that the given node postdominates - cfPostDominators :: M.Map Node (S.Set Node) + -- An array (from,to) saying whether 'from' postdominates 'to' + cfPostDominators :: Array Node [Node] } - deriving (Show, Generic, NFData) + deriving (Show) buildGraph :: CFGParameters -> Token -> CFGResult buildGraph params root = @@ -200,7 +202,7 @@ buildGraph params root = cfPostDominators = findPostDominators mainExit $ mkGraph nodes onlyRealEdges } in - deepseq result result + result remapGraph :: M.Map Node Node -> CFW -> CFW remapGraph remap (nodes, edges, mapping, assoc) = @@ -1256,8 +1258,8 @@ findTerminalNodes graph = ufold find [] graph f (IdTagged _ (CFDefineFunction _ id start end):rest) list = f rest (end:list) f (_:rest) list = f rest list -findPostDominators :: Node -> CFGraph -> M.Map Node (S.Set Node) -findPostDominators mainexit graph = asSetMap +findPostDominators :: Node -> CFGraph -> Array Node [Node] +findPostDominators mainexit graph = asArray where inlined = inlineSubshells graph terminals = findTerminalNodes inlined @@ -1265,7 +1267,8 @@ findPostDominators mainexit graph = asSetMap withExitEdges = (incoming ++ map (\c -> (CFEFlow, c)) terminals, mainexit, label, outgoing) `safeUpdate` inlined reversed = grev withExitEdges postDoms = dom reversed mainexit - asSetMap = M.fromList $ map (\(node, list) -> (node, S.fromList list)) postDoms + (_, maxNode) = nodeRange graph + asArray = array (0, maxNode) postDoms return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index ff88810..e6b1701 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -69,6 +69,7 @@ import Control.Monad import Control.Monad.ST import Control.DeepSeq import Data.List hiding (map) +import Data.Array.Unboxed import Data.STRef import Data.Maybe import qualified Data.Map as M @@ -100,9 +101,9 @@ data CFGAnalysis = CFGAnalysis { graph :: CFGraph, tokenToRange :: M.Map Id (Node, Node), tokenToNodes :: M.Map Id (S.Set Node), - postDominators :: M.Map Node (S.Set Node), + postDominators :: Array Node [Node], nodeToData :: M.Map Node (ProgramState, ProgramState) -} deriving (Show, Generic, NFData) +} deriving (Show) -- The program state we expose externally data ProgramState = ProgramState { @@ -147,8 +148,7 @@ doesPostDominate :: CFGAnalysis -> Id -> Id -> Bool doesPostDominate analysis target base = fromMaybe False $ do (_, baseEnd) <- M.lookup base $ tokenToRange analysis (targetStart, _) <- M.lookup target $ tokenToRange analysis - postDoms <- M.lookup baseEnd $ postDominators analysis - return $ S.member targetStart postDoms + return $ targetStart `elem` (postDominators analysis ! baseEnd) getDataForNode analysis node = M.lookup node $ nodeToData analysis From 0df934514298adadc40651696d5b854784efa0a5 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 2 Aug 2022 11:25:35 -0700 Subject: [PATCH 053/244] Trace numerical status, use for SC2071 (ref #2541) --- src/ShellCheck/Analytics.hs | 21 +++++++-- src/ShellCheck/CFGAnalysis.hs | 84 ++++++++++++++++++++++++++--------- 2 files changed, 82 insertions(+), 23 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e878dc4..b5bac35 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1167,6 +1167,10 @@ prop_checkNumberComparisons18 = verify checkNumberComparisons "[[ foo -eq 2 ]]" prop_checkNumberComparisons19 = verifyNot checkNumberComparisons "foo=1; [[ foo -eq 2 ]]" prop_checkNumberComparisons20 = verify checkNumberComparisons "[[ 2 -eq / ]]" prop_checkNumberComparisons21 = verify checkNumberComparisons "[[ foo -eq foo ]]" +prop_checkNumberComparisons22 = verify checkNumberComparisons "x=10; [[ $x > $z ]]" +prop_checkNumberComparisons23 = verify checkNumberComparisons "x=0; if [[ -n $def ]]; then x=$def; fi; while [ $x > $z ]; do lol; done" +prop_checkNumberComparisons24 = verify checkNumberComparisons "x=$RANDOM; [ $x > $z ]" +prop_checkNumberComparisons25 = verify checkNumberComparisons "[[ $((n++)) > $x ]]" checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do if isNum lhs || isNum rhs @@ -1242,9 +1246,20 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do numChar x = isDigit x || x `elem` "+-. " isNum t = - case oversimplify t of - [v] -> all isDigit v - _ -> False + case getWordParts t of + [T_DollarArithmetic {}] -> True + [b@(T_DollarBraced id _ c)] -> + let + str = concat $ oversimplify c + var = getBracedReference str + in fromMaybe False $ do + state <- CF.getIncomingState (cfgAnalysis params) id + value <- Map.lookup var $ CF.variablesInScope state + return $ CF.numericalStatus (CF.variableValue value) >= CF.NumericalStatusMaybe + _ -> + case oversimplify t of + [v] -> all isDigit v + _ -> False isFraction t = case oversimplify t of diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index e6b1701..634d354 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -54,29 +54,31 @@ module ShellCheck.CFGAnalysis ( ,VariableValue (..) ,VariableProperties ,SpaceStatus (..) + ,NumericalStatus (..) ,getIncomingState ,getOutgoingState ,doesPostDominate ,ShellCheck.CFGAnalysis.runTests -- STRIP ) where -import GHC.Generics (Generic) -import ShellCheck.AST -import ShellCheck.CFG -import qualified ShellCheck.Data as Data -import ShellCheck.Prelude +import Control.DeepSeq import Control.Monad import Control.Monad.ST -import Control.DeepSeq -import Data.List hiding (map) import Data.Array.Unboxed -import Data.STRef -import Data.Maybe -import qualified Data.Map as M -import qualified Data.Set as S +import Data.Char import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Query.DFS +import Data.List hiding (map) +import Data.Maybe +import Data.STRef import Debug.Trace -- STRIP +import GHC.Generics (Generic) +import qualified Data.Map as M +import qualified Data.Set as S +import qualified ShellCheck.Data as Data +import ShellCheck.AST +import ShellCheck.CFG +import ShellCheck.Prelude import Test.QuickCheck @@ -183,16 +185,20 @@ createEnvironmentState = do foldl' (flip ($)) newInternalState $ concat [ addVars Data.internalVariables unknownVariableState, addVars Data.variablesWithoutSpaces spacelessVariableState, - addVars Data.specialIntegerVariables spacelessVariableState + addVars Data.specialIntegerVariables integerVariableState ] where addVars names val = map (\name -> insertGlobal name val) names spacelessVariableState = unknownVariableState { variableValue = VariableValue { literalValue = Nothing, - spaceStatus = SpaceStatusClean + spaceStatus = SpaceStatusClean, + numericalStatus = NumericalStatusUnknown } } + integerVariableState = unknownVariableState { + variableValue = unknownIntegerValue + } modified s = s { sVersion = -1 } @@ -289,7 +295,8 @@ unknownFunctionValue = S.singleton FunctionUnknown -- The information about the value of a single variable data VariableValue = VariableValue { literalValue :: Maybe String, -- TODO: For debugging. Remove me. - spaceStatus :: SpaceStatus + spaceStatus :: SpaceStatus, + numericalStatus :: NumericalStatus } deriving (Show, Eq, Ord, Generic, NFData) @@ -301,6 +308,9 @@ data VariableState = VariableState { -- Whether or not the value needs quoting (has spaces/globs), or we don't know data SpaceStatus = SpaceStatusEmpty | SpaceStatusClean | SpaceStatusDirty deriving (Show, Eq, Ord, Generic, NFData) +-- +-- Whether or not the value needs quoting (has spaces/globs), or we don't know +data NumericalStatus = NumericalStatusUnknown | NumericalStatusEmpty | NumericalStatusMaybe | NumericalStatusDefinitely deriving (Show, Eq, Ord, Generic, NFData) -- The set of possible sets of properties for this variable type VariableProperties = S.Set (S.Set CFVariableProp) @@ -314,12 +324,14 @@ unknownVariableState = VariableState { unknownVariableValue = VariableValue { literalValue = Nothing, - spaceStatus = SpaceStatusDirty + spaceStatus = SpaceStatusDirty, + numericalStatus = NumericalStatusUnknown } emptyVariableValue = unknownVariableValue { literalValue = Just "", - spaceStatus = SpaceStatusEmpty + spaceStatus = SpaceStatusEmpty, + numericalStatus = NumericalStatusEmpty } unsetVariableState = VariableState { @@ -334,7 +346,8 @@ mergeVariableState a b = VariableState { mergeVariableValue a b = VariableValue { literalValue = if literalValue a == literalValue b then literalValue a else Nothing, - spaceStatus = mergeSpaceStatus (spaceStatus a) (spaceStatus b) + spaceStatus = mergeSpaceStatus (spaceStatus a) (spaceStatus b), + numericalStatus = mergeNumericalStatus (numericalStatus a) (numericalStatus b) } mergeSpaceStatus a b = @@ -344,6 +357,16 @@ mergeSpaceStatus a b = (SpaceStatusClean, SpaceStatusClean) -> SpaceStatusClean _ -> SpaceStatusDirty +mergeNumericalStatus a b = + case (a,b) of + (NumericalStatusDefinitely, NumericalStatusDefinitely) -> NumericalStatusDefinitely + (NumericalStatusDefinitely, _) -> NumericalStatusMaybe + (_, NumericalStatusDefinitely) -> NumericalStatusMaybe + (NumericalStatusMaybe, _) -> NumericalStatusMaybe + (_, NumericalStatusMaybe) -> NumericalStatusMaybe + (NumericalStatusEmpty, NumericalStatusEmpty) -> NumericalStatusEmpty + _ -> NumericalStatusUnknown + -- A VersionedMap is a Map that keeps an additional integer version to quickly determine if it has changed. -- * Version -1 means it's unknown (possibly and presumably changed) -- * Version 0 means it's empty @@ -1154,7 +1177,8 @@ appendVariableValue :: VariableValue -> VariableValue -> VariableValue appendVariableValue a b = unknownVariableValue { literalValue = liftM2 (++) (literalValue a) (literalValue b), - spaceStatus = appendSpaceStatus (spaceStatus a) (spaceStatus b) + spaceStatus = appendSpaceStatus (spaceStatus a) (spaceStatus b), + numericalStatus = appendNumericalStatus (numericalStatus a) (numericalStatus b) } appendSpaceStatus a b = @@ -1164,14 +1188,25 @@ appendSpaceStatus a b = (SpaceStatusClean, SpaceStatusClean) -> a _ ->SpaceStatusDirty +appendNumericalStatus a b = + case (a,b) of + (NumericalStatusEmpty, x) -> x + (x, NumericalStatusEmpty) -> x + (NumericalStatusDefinitely, NumericalStatusDefinitely) -> NumericalStatusDefinitely + (NumericalStatusUnknown, _) -> NumericalStatusUnknown + (_, NumericalStatusUnknown) -> NumericalStatusUnknown + _ -> NumericalStatusMaybe + unknownIntegerValue = unknownVariableValue { literalValue = Nothing, - spaceStatus = SpaceStatusClean + spaceStatus = SpaceStatusClean, + numericalStatus = NumericalStatusDefinitely } literalToVariableValue str = unknownVariableValue { literalValue = Just str, - spaceStatus = literalToSpaceStatus str + spaceStatus = literalToSpaceStatus str, + numericalStatus = literalToNumericalStatus str } withoutChanges ctx f = do @@ -1191,6 +1226,15 @@ literalToSpaceStatus str = _ | all (`notElem` " \t\n*?[") str -> SpaceStatusClean _ -> SpaceStatusDirty +-- Get the NumericalStatus for a literal string, i.e. whether it's an integer +literalToNumericalStatus str = + case str of + "" -> NumericalStatusEmpty + '-':rest -> if isNumeric rest then NumericalStatusDefinitely else NumericalStatusUnknown + rest -> if isNumeric rest then NumericalStatusDefinitely else NumericalStatusUnknown + where + isNumeric = all isDigit + type StateMap = M.Map Node (InternalState, InternalState) -- Classic, iterative Data Flow Analysis. See Wikipedia for a description of the process. From 4806719035de364dd2d49f97112dd8b3a255e3b0 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 2 Aug 2022 15:47:59 -0700 Subject: [PATCH 054/244] Handle variable assignments from `read` in CFG --- src/ShellCheck/CFG.hs | 35 ++++++++++++++++++++++++++++++++++- src/ShellCheck/Data.hs | 1 + 2 files changed, 35 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index 771e870..e0c6267 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -41,6 +41,7 @@ module ShellCheck.CFG ( import GHC.Generics (Generic) import ShellCheck.AST import ShellCheck.ASTLib +import ShellCheck.Data import ShellCheck.Interface import ShellCheck.Prelude import ShellCheck.Regex @@ -936,6 +937,8 @@ handleCommand cmd vars args literalCmd = do Just "mapfile" -> regularExpansionWithStatus vars args $ handleMapfile args Just "readarray" -> regularExpansionWithStatus vars args $ handleMapfile args + Just "read" -> regularExpansionWithStatus vars args $ handleRead args + Just "DEFINE_boolean" -> regularExpansionWithStatus vars args $ handleDEFINE args Just "DEFINE_float" -> regularExpansionWithStatus vars args $ handleDEFINE args Just "DEFINE_integer" -> regularExpansionWithStatus vars args $ handleDEFINE args @@ -1113,7 +1116,7 @@ handleCommand cmd vars args literalCmd = do in IdTagged id $ CFWriteVariable name CFValueArray getFromArg = do - flags <- getGnuOpts "d:n:O:s:u:C:c:t" args + flags <- getGnuOpts flagsForMapfile args (_, arg) <- lookup "" flags name <- getLiteralString arg return (getId arg, name) @@ -1125,6 +1128,36 @@ handleCommand cmd vars args literalCmd = do guard $ isVariableName name return (getId c, name) + handleRead (cmd:args) = newNodeRange $ CFApplyEffects main + where + main = fromMaybe fallback $ do + flags <- getGnuOpts flagsForRead args + return $ fromMaybe (withFields flags) $ withArray flags + + withArray :: [(String, (Token, Token))] -> Maybe [IdTagged CFEffect] + withArray flags = do + (_, token) <- lookup "a" flags + return $ fromMaybe [] $ do + name <- getLiteralString token + return [ IdTagged (getId token) $ CFWriteVariable name CFValueArray ] + + withFields flags = mapMaybe getAssignment flags + + getAssignment :: (String, (Token, Token)) -> Maybe (IdTagged CFEffect) + getAssignment f = do + ("", (t, _)) <- return f + name <- getLiteralString t + return $ IdTagged (getId t) $ CFWriteVariable name CFValueString + + fallback = + let + names = reverse $ map fromJust $ takeWhile isJust $ map (\c -> sequence (getId c, getLiteralString c)) $ reverse args + namesOrDefault = if null names then [(getId cmd, "REPLY")] else names + hasDashA = any (== "a") $ map fst $ getGenericOpts args + value = if hasDashA then CFValueArray else CFValueString + in + map (\(id, name) -> IdTagged id $ CFWriteVariable name value) namesOrDefault + handleDEFINE (cmd:args) = newNodeRange $ CFApplyEffects $ maybeToList findVar where diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index fb82ca8..4090922 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -159,5 +159,6 @@ shellForExecutable name = _ -> Nothing flagsForRead = "sreu:n:N:i:p:a:t:" +flagsForMapfile = "d:n:O:s:u:C:c:t" declaringCommands = ["local", "declare", "export", "readonly", "typeset", "let"] From ccab132b385a215a37ce7e6f4d2601454b0437b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lawrence=20Vel=C3=A1zquez?= Date: Tue, 20 Sep 2022 17:36:46 -0400 Subject: [PATCH 055/244] Reflow lists of internal shell variables No functional changes; this just makes the next few commits cleaner. --- src/ShellCheck/Data.hs | 41 +++++++++++++++++++++++------------------ 1 file changed, 23 insertions(+), 18 deletions(-) diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 4090922..3c9013f 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -30,23 +30,26 @@ internalVariables = [ -- Bash "BASH", "BASHOPTS", "BASHPID", "BASH_ALIASES", "BASH_ARGC", - "BASH_ARGV", "BASH_CMDS", "BASH_COMMAND", "BASH_EXECUTION_STRING", - "BASH_LINENO", "BASH_REMATCH", "BASH_SOURCE", "BASH_SUBSHELL", - "BASH_VERSINFO", "BASH_VERSION", "COMP_CWORD", "COMP_KEY", - "COMP_LINE", "COMP_POINT", "COMP_TYPE", "COMP_WORDBREAKS", - "COMP_WORDS", "COPROC", "DIRSTACK", "EUID", "FUNCNAME", "GROUPS", - "HISTCMD", "HOSTNAME", "HOSTTYPE", "LINENO", "MACHTYPE", "MAPFILE", - "OLDPWD", "OPTARG", "OPTIND", "OSTYPE", "PIPESTATUS", "PPID", "PWD", - "RANDOM", "READLINE_LINE", "READLINE_POINT", "REPLY", "SECONDS", - "SHELLOPTS", "SHLVL", "UID", "BASH_ENV", "BASH_XTRACEFD", "CDPATH", - "COLUMNS", "COMPREPLY", "EMACS", "ENV", "FCEDIT", "FIGNORE", + "BASH_ARGV", "BASH_CMDS", "BASH_COMMAND", + "BASH_EXECUTION_STRING", "BASH_LINENO", + "BASH_REMATCH", "BASH_SOURCE", "BASH_SUBSHELL", "BASH_VERSINFO", + "BASH_VERSION", "COMP_CWORD", "COMP_KEY", "COMP_LINE", "COMP_POINT", + "COMP_TYPE", "COMP_WORDBREAKS", "COMP_WORDS", "COPROC", "DIRSTACK", + "EUID", "FUNCNAME", "GROUPS", "HISTCMD", + "HOSTNAME", "HOSTTYPE", "LINENO", "MACHTYPE", "MAPFILE", "OLDPWD", + "OPTARG", "OPTIND", "OSTYPE", "PIPESTATUS", "PPID", "PWD", "RANDOM", + "READLINE_LINE", "READLINE_POINT", + "REPLY", "SECONDS", "SHELLOPTS", "SHLVL", "UID", + "BASH_ENV", "BASH_XTRACEFD", "CDPATH", "COLUMNS", + "COMPREPLY", "EMACS", "ENV", "FCEDIT", "FIGNORE", "FUNCNEST", "GLOBIGNORE", "HISTCONTROL", "HISTFILE", "HISTFILESIZE", "HISTIGNORE", "HISTSIZE", "HISTTIMEFORMAT", "HOME", "HOSTFILE", "IFS", - "IGNOREEOF", "INPUTRC", "LANG", "LC_ALL", "LC_COLLATE", "LC_CTYPE", - "LC_MESSAGES", "LC_MONETARY", "LC_NUMERIC", "LC_TIME", "LINES", "MAIL", - "MAILCHECK", "MAILPATH", "OPTERR", "PATH", "POSIXLY_CORRECT", - "PROMPT_COMMAND", "PROMPT_DIRTRIM", "PS1", "PS2", "PS3", "PS4", "SHELL", - "TIMEFORMAT", "TMOUT", "TMPDIR", "auto_resume", "histchars", "COPROC", + "IGNOREEOF", "INPUTRC", "LANG", "LC_ALL", "LC_COLLATE", + "LC_CTYPE", "LC_MESSAGES", "LC_MONETARY", "LC_NUMERIC", "LC_TIME", + "LINES", "MAIL", "MAILCHECK", "MAILPATH", "OPTERR", "PATH", + "POSIXLY_CORRECT", "PROMPT_COMMAND", "PROMPT_DIRTRIM", "PS1", + "PS2", "PS3", "PS4", "SHELL", "TIMEFORMAT", "TMOUT", "TMPDIR", + "auto_resume", "histchars", "COPROC", -- Other "USER", "TZ", "TERM", "LOGNAME", "LD_LIBRARY_PATH", "LANGUAGE", "DISPLAY", @@ -68,9 +71,11 @@ specialIntegerVariables = [ specialVariablesWithoutSpaces = "-" : specialIntegerVariables variablesWithoutSpaces = specialVariablesWithoutSpaces ++ [ - "BASHPID", "BASH_ARGC", "BASH_LINENO", "BASH_SUBSHELL", "EUID", "LINENO", - "OPTIND", "PPID", "RANDOM", "SECONDS", "SHELLOPTS", "SHLVL", "UID", - "COLUMNS", "HISTFILESIZE", "HISTSIZE", "LINES" + "BASHPID", "BASH_ARGC", "BASH_LINENO", "BASH_SUBSHELL", "EUID", + "LINENO", "OPTIND", "PPID", "RANDOM", + "SECONDS", + "SHELLOPTS", "SHLVL", "UID", "COLUMNS", "HISTFILESIZE", + "HISTSIZE", "LINES" -- shflags , "FLAGS_ERROR", "FLAGS_FALSE", "FLAGS_TRUE" From f28462b01ca634b4649e0a6dd11a0a8a207d5729 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lawrence=20Vel=C3=A1zquez?= Date: Tue, 20 Sep 2022 19:10:39 -0400 Subject: [PATCH 056/244] Remove duplicate "COPROC" from internal vars list --- src/ShellCheck/Data.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 3c9013f..8c65474 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -49,7 +49,7 @@ internalVariables = [ "LINES", "MAIL", "MAILCHECK", "MAILPATH", "OPTERR", "PATH", "POSIXLY_CORRECT", "PROMPT_COMMAND", "PROMPT_DIRTRIM", "PS1", "PS2", "PS3", "PS4", "SHELL", "TIMEFORMAT", "TMOUT", "TMPDIR", - "auto_resume", "histchars", "COPROC", + "auto_resume", "histchars", -- Other "USER", "TZ", "TERM", "LOGNAME", "LD_LIBRARY_PATH", "LANGUAGE", "DISPLAY", From 966fb3e3dd3b49e64f022478f18f7aa4bad53a27 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lawrence=20Vel=C3=A1zquez?= Date: Tue, 20 Sep 2022 19:12:05 -0400 Subject: [PATCH 057/244] Recognize more Bash internal variables - BASH_ARGV0, introduced in Bash 5.0 - BASH_COMPAT, 4.3 - BASH_LOADABLES_PATH, 4.4 - CHILD_MAX, 4.3 - EPOCHREALTIME, 5.0 - EPOCHSECONDS, 5.0 - EXECIGNORE, 4.4 - INSIDE_EMACS, 4.4 - PS0, 4.4 - READLINE_ARGUMENT, 5.2 - READLINE_MARK, 5.1 - SRANDOM, 5.1 Fixes #1780 and #2554. --- src/ShellCheck/Data.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 8c65474..35f314f 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -30,24 +30,24 @@ internalVariables = [ -- Bash "BASH", "BASHOPTS", "BASHPID", "BASH_ALIASES", "BASH_ARGC", - "BASH_ARGV", "BASH_CMDS", "BASH_COMMAND", - "BASH_EXECUTION_STRING", "BASH_LINENO", + "BASH_ARGV", "BASH_ARGV0", "BASH_CMDS", "BASH_COMMAND", + "BASH_EXECUTION_STRING", "BASH_LINENO", "BASH_LOADABLES_PATH", "BASH_REMATCH", "BASH_SOURCE", "BASH_SUBSHELL", "BASH_VERSINFO", "BASH_VERSION", "COMP_CWORD", "COMP_KEY", "COMP_LINE", "COMP_POINT", "COMP_TYPE", "COMP_WORDBREAKS", "COMP_WORDS", "COPROC", "DIRSTACK", - "EUID", "FUNCNAME", "GROUPS", "HISTCMD", + "EPOCHREALTIME", "EPOCHSECONDS", "EUID", "FUNCNAME", "GROUPS", "HISTCMD", "HOSTNAME", "HOSTTYPE", "LINENO", "MACHTYPE", "MAPFILE", "OLDPWD", "OPTARG", "OPTIND", "OSTYPE", "PIPESTATUS", "PPID", "PWD", "RANDOM", - "READLINE_LINE", "READLINE_POINT", - "REPLY", "SECONDS", "SHELLOPTS", "SHLVL", "UID", - "BASH_ENV", "BASH_XTRACEFD", "CDPATH", "COLUMNS", - "COMPREPLY", "EMACS", "ENV", "FCEDIT", "FIGNORE", + "READLINE_ARGUMENT", "READLINE_LINE", "READLINE_MARK", "READLINE_POINT", + "REPLY", "SECONDS", "SHELLOPTS", "SHLVL", "SRANDOM", "UID", "BASH_COMPAT", + "BASH_ENV", "BASH_XTRACEFD", "CDPATH", "CHILD_MAX", "COLUMNS", + "COMPREPLY", "EMACS", "ENV", "EXECIGNORE", "FCEDIT", "FIGNORE", "FUNCNEST", "GLOBIGNORE", "HISTCONTROL", "HISTFILE", "HISTFILESIZE", "HISTIGNORE", "HISTSIZE", "HISTTIMEFORMAT", "HOME", "HOSTFILE", "IFS", - "IGNOREEOF", "INPUTRC", "LANG", "LC_ALL", "LC_COLLATE", + "IGNOREEOF", "INPUTRC", "INSIDE_EMACS", "LANG", "LC_ALL", "LC_COLLATE", "LC_CTYPE", "LC_MESSAGES", "LC_MONETARY", "LC_NUMERIC", "LC_TIME", "LINES", "MAIL", "MAILCHECK", "MAILPATH", "OPTERR", "PATH", - "POSIXLY_CORRECT", "PROMPT_COMMAND", "PROMPT_DIRTRIM", "PS1", + "POSIXLY_CORRECT", "PROMPT_COMMAND", "PROMPT_DIRTRIM", "PS0", "PS1", "PS2", "PS3", "PS4", "SHELL", "TIMEFORMAT", "TMOUT", "TMPDIR", "auto_resume", "histchars", @@ -72,9 +72,9 @@ specialVariablesWithoutSpaces = "-" : specialIntegerVariables variablesWithoutSpaces = specialVariablesWithoutSpaces ++ [ "BASHPID", "BASH_ARGC", "BASH_LINENO", "BASH_SUBSHELL", "EUID", - "LINENO", "OPTIND", "PPID", "RANDOM", - "SECONDS", - "SHELLOPTS", "SHLVL", "UID", "COLUMNS", "HISTFILESIZE", + "EPOCHREALTIME", "EPOCHSECONDS", "LINENO", "OPTIND", "PPID", "RANDOM", + "READLINE_ARGUMENT", "READLINE_MARK", "SECONDS", + "SHELLOPTS", "SHLVL", "SRANDOM", "UID", "COLUMNS", "HISTFILESIZE", "HISTSIZE", "LINES" -- shflags From 0845b8118352c929d414231af23d302cb748178d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lawrence=20Vel=C3=A1zquez?= Date: Tue, 20 Sep 2022 20:00:23 -0400 Subject: [PATCH 058/244] Add READLINE_POINT to list of variables without spaces --- src/ShellCheck/Data.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 35f314f..7d6f5b4 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -73,7 +73,7 @@ specialVariablesWithoutSpaces = "-" : specialIntegerVariables variablesWithoutSpaces = specialVariablesWithoutSpaces ++ [ "BASHPID", "BASH_ARGC", "BASH_LINENO", "BASH_SUBSHELL", "EUID", "EPOCHREALTIME", "EPOCHSECONDS", "LINENO", "OPTIND", "PPID", "RANDOM", - "READLINE_ARGUMENT", "READLINE_MARK", "SECONDS", + "READLINE_ARGUMENT", "READLINE_MARK", "READLINE_POINT", "SECONDS", "SHELLOPTS", "SHLVL", "SRANDOM", "UID", "COLUMNS", "HISTFILESIZE", "HISTSIZE", "LINES" From fcc473e27fffc2dfe404c24b30f2cbb7e897ace8 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Wed, 21 Sep 2022 18:11:18 -0700 Subject: [PATCH 059/244] Include inherited env for DFA of leftover functions (fixes #2560) --- src/ShellCheck/Analytics.hs | 2 ++ src/ShellCheck/CFGAnalysis.hs | 8 ++++---- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index b5bac35..e9ea36a 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2099,6 +2099,8 @@ prop_checkSpacefulnessCfg61 = verify checkSpacefulnessCfg "declare -x X; y=foo$X prop_checkSpacefulnessCfg62 = verifyNot checkSpacefulnessCfg "f() { declare -x X; y=foo$X; echo $y; }" prop_checkSpacefulnessCfg63 = verify checkSpacefulnessCfg "f && declare -i s; s='x + y'; echo $s" prop_checkSpacefulnessCfg64 = verifyNot checkSpacefulnessCfg "declare -i s; s='x + y'; x=$s; echo $x" +prop_checkSpacefulnessCfg65 = verifyNot checkSpacefulnessCfg "f() { s=$?; echo $s; }; f" +prop_checkSpacefulnessCfg66 = verifyNot checkSpacefulnessCfg "f() { s=$?; echo $s; }" checkSpacefulnessCfg = checkSpacefulnessCfg' True checkVerboseSpacefulnessCfg = checkSpacefulnessCfg' False diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 634d354..7b270a8 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -1300,8 +1300,7 @@ dataflow ctx entry = do outgoing = map snd outgoingL isRegular = ((== CFEFlow) . fst) -runRoot ctx entry exit = do - let env = createEnvironmentState +runRoot ctx env entry exit = do writeSTRef (cInput ctx) $ env writeSTRef (cOutput ctx) $ env writeSTRef (cNode ctx) $ entry @@ -1321,9 +1320,10 @@ analyzeControlFlow params t = runST $ f cfg entry exit where f cfg entry exit = do + let env = createEnvironmentState ctx <- newCtx $ cfGraph cfg -- Do a dataflow analysis starting on the root node - exitState <- runRoot ctx entry exit + exitState <- runRoot ctx env entry exit -- All nodes we've touched invocations <- readSTRef $ cInvocations ctx @@ -1336,7 +1336,7 @@ analyzeControlFlow params t = let uninvoked = M.difference declaredFunctions invokedNodes let stragglerInput = - exitState { + (env `patchState` exitState) { -- We don't want `die() { exit $?; }; echo "Sourced"` to assume $? is always echo sExitCodes = Nothing } From 581981ba7696e642ce4ffa57d6cc2a585ad631d5 Mon Sep 17 00:00:00 2001 From: Christian Nassif-Haynes Date: Sat, 24 Sep 2022 07:20:48 +1000 Subject: [PATCH 060/244] Suppress SC2311 with `set -o posix` --- src/ShellCheck/Analytics.hs | 1 + src/ShellCheck/AnalyzerLib.hs | 21 +++++++++------------ 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e9ea36a..9d924f6 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4686,6 +4686,7 @@ prop_checkSetESuppressed15 = verifyTree checkSetESuppressed "set -e; f(){ :; 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)" +prop_checkSetESuppressed19 = verifyNotTree checkSetESuppressed "set -e; set -o posix; f(){ :; }; x=$(f)" checkSetESuppressed params t = if hasSetE params then runNodeAnalysis checkNode params t else [] where diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 88da89e..444c751 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -203,22 +203,22 @@ makeParameters spec = params hasSetE = containsSetE root, hasLastpipe = case shellType params of - Bash -> containsLastpipe root + Bash -> isOptionSet "lastpipe" root Dash -> False Sh -> False Ksh -> True, hasInheritErrexit = case shellType params of - Bash -> containsInheritErrexit root + Bash -> isOptionSet "inherit_errexit" root Dash -> True Sh -> True Ksh -> False, hasPipefail = case shellType params of - Bash -> containsPipefail root + Bash -> isOptionSet "pipefail" root Dash -> True Sh -> True - Ksh -> containsPipefail root, + Ksh -> isOptionSet "pipefail" root, shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec), idMap = getTokenMap root, parentMap = getParentTree root, @@ -247,13 +247,14 @@ containsSetE root = isNothing $ doAnalysis (guard . not . isSetE) root _ -> False re = mkRegex "[[:space:]]-[^-]*e" -containsPipefail root = isNothing $ doAnalysis (guard . not . isPipefail) root + +containsSetOption opt root = isNothing $ doAnalysis (guard . not . isPipefail) root where isPipefail t = case t of T_SimpleCommand {} -> t `isUnqualifiedCommand` "set" && - ("pipefail" `elem` oversimplify t || + (opt `elem` oversimplify t || "o" `elem` map snd (getAllFlags t)) _ -> False @@ -267,12 +268,8 @@ containsShopt shopt root = (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" +-- Does this script mention 'shopt -s $opt' or 'set -o $opt' anywhere? +isOptionSet opt root = containsShopt opt root || containsSetOption opt root prop_determineShell0 = determineShellTest "#!/bin/sh" == Sh From ef5f9a7af5e2f8287c535a45bba352ea193aab4b Mon Sep 17 00:00:00 2001 From: Christian Nassif-Haynes Date: Sun, 25 Sep 2022 03:04:20 +1000 Subject: [PATCH 061/244] Add `mapfile` to harmless commands for SC2094 --- src/ShellCheck/Analytics.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e9ea36a..7237462 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -807,6 +807,7 @@ prop_checkRedirectToSame6 = verifyNot checkRedirectToSame "echo foo > foo" prop_checkRedirectToSame7 = verifyNot checkRedirectToSame "sed 's/foo/bar/g' file | sponge file" prop_checkRedirectToSame8 = verifyNot checkRedirectToSame "while read -r line; do _=\"$fname\"; done <\"$fname\"" prop_checkRedirectToSame9 = verifyNot checkRedirectToSame "while read -r line; do cat < \"$fname\"; done <\"$fname\"" +prop_checkRedirectToSame10 = verifyNot checkRedirectToSame "mapfile -t foo (mapM_ (\x -> doAnalysis (checkOccurrences x) l) (getAllRedirs list))) list where @@ -852,7 +853,7 @@ checkRedirectToSame params s@(T_Pipeline _ _ list) = isHarmlessCommand arg = fromMaybe False $ do cmd <- getClosestCommand (parentMap params) arg name <- getCommandBasename cmd - return $ name `elem` ["echo", "printf", "sponge"] + return $ name `elem` ["echo", "mapfile", "printf", "sponge"] containsAssignment arg = fromMaybe False $ do cmd <- getClosestCommand (parentMap params) arg return $ isAssignment cmd From 128351f5ef002be2ca3d2b2e3e2859c2c6c84e9a Mon Sep 17 00:00:00 2001 From: Peter Oliver Date: Fri, 7 Oct 2022 17:02:31 +0100 Subject: [PATCH 062/244] Permit colon after exec MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ShellCheck throws warning SC2093 when a script contains commands that could never be executed because they are after an `exec`. Command `:` does nothing, so add it to the list of commands that don’t trigger this warning. --- src/ShellCheck/Analytics.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index aa99934..ba2379d 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1876,6 +1876,7 @@ prop_checkSpuriousExec7 = verifyNot checkSpuriousExec "exec file; echo failed; e prop_checkSpuriousExec8 = verifyNot checkSpuriousExec "exec {origout}>&1- >tmp.log 2>&1; bar" prop_checkSpuriousExec9 = verify checkSpuriousExec "for file in rc.d/*; do exec \"$file\"; done" prop_checkSpuriousExec10 = verifyNot checkSpuriousExec "exec file; r=$?; printf >&2 'failed\n'; return $r" +prop_checkSpuriousExec11 = verifyNot checkSpuriousExec "exec file; :" checkSpuriousExec _ = doLists where doLists (T_Script _ _ cmds) = doList cmds False @@ -1891,7 +1892,7 @@ checkSpuriousExec _ = doLists stripCleanup = reverse . dropWhile cleanup . reverse cleanup (T_Pipeline _ _ [cmd]) = - isCommandMatch cmd (`elem` ["echo", "exit", "printf", "return"]) + isCommandMatch cmd (`elem` [":", "echo", "exit", "printf", "return"]) || isAssignment cmd cleanup _ = False From 43aca62ca7ffa84a406623d81fd67758b577bfa5 Mon Sep 17 00:00:00 2001 From: Christian Nassif-Haynes Date: Sun, 9 Oct 2022 07:59:05 +1100 Subject: [PATCH 063/244] Fix false positive for SC2312 when using `time` --- src/ShellCheck/Analytics.hs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index aa99934..bf77c9c 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4765,8 +4765,12 @@ prop_checkExtraMaskedReturns32 = verifyNotTree checkExtraMaskedReturns "false < prop_checkExtraMaskedReturns33 = verifyNotTree checkExtraMaskedReturns "{ false || true; } | true" prop_checkExtraMaskedReturns34 = verifyNotTree checkExtraMaskedReturns "{ false || :; } | true" prop_checkExtraMaskedReturns35 = verifyTree checkExtraMaskedReturns "f() { local -r x=$(false); }" +prop_checkExtraMaskedReturns36 = verifyNotTree checkExtraMaskedReturns "time false" +prop_checkExtraMaskedReturns37 = verifyNotTree checkExtraMaskedReturns "time $(time false)" +prop_checkExtraMaskedReturns38 = verifyTree checkExtraMaskedReturns "x=$(time time time false) time $(time false)" -checkExtraMaskedReturns params t = runNodeAnalysis findMaskingNodes params t +checkExtraMaskedReturns params t = + runNodeAnalysis findMaskingNodes params (removeTransparentCommands t) where findMaskingNodes _ (T_Arithmetic _ list) = findMaskedNodesInList [list] findMaskingNodes _ (T_Array _ list) = findMaskedNodesInList $ allButLastSimpleCommands list @@ -4799,6 +4803,13 @@ checkExtraMaskedReturns params t = runNodeAnalysis findMaskingNodes params t where simpleCommands = filter containsSimpleCommand cmds + removeTransparentCommands t = + doTransform go t + where + go cmd@(T_SimpleCommand id assigns (_:args)) | isTransparentCommand cmd + = T_SimpleCommand id assigns args + go t = t + inform t = info (getId t) 2312 ("Consider invoking this command " ++ "separately to avoid masking its return value (or use '|| true' " ++ "to ignore).") @@ -4831,6 +4842,10 @@ checkExtraMaskedReturns params t = runNodeAnalysis findMaskingNodes params t ,"shopt" ] + isTransparentCommand t = fromMaybe False $ do + basename <- getCommandBasename t + return $ basename == "time" + parentChildPairs t = go $ parents params t where go (child:parent:rest) = (parent, child):go (parent:rest) From 81c2ecaccb47ced29e9e596f0d53b3068eff6811 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 11 Oct 2022 19:40:29 -0700 Subject: [PATCH 064/244] Remove true/false from SC2216/SC2217 (fixes #2603) --- src/ShellCheck/Data.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 7d6f5b4..550ff87 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -121,10 +121,10 @@ commonCommands = [ nonReadingCommands = [ "alias", "basename", "bg", "cal", "cd", "chgrp", "chmod", "chown", - "cp", "du", "echo", "export", "false", "fg", "fuser", "getconf", + "cp", "du", "echo", "export", "fg", "fuser", "getconf", "getopt", "getopts", "ipcrm", "ipcs", "jobs", "kill", "ln", "ls", "locale", "mv", "printf", "ps", "pwd", "renice", "rm", "rmdir", - "set", "sleep", "touch", "trap", "true", "ulimit", "unalias", "uname" + "set", "sleep", "touch", "trap", "ulimit", "unalias", "uname" ] sampleWords = [ From fa7943ac0e79dc3ac94bede40c55b8f407a699d6 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 11 Oct 2022 20:10:34 -0700 Subject: [PATCH 065/244] Revert "Add employer mandated disclaimer" This reverts commit 5202072a3439935fbc5a9b92fe66833633f63437. --- LICENSE | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/LICENSE b/LICENSE index 0df6056..f288702 100644 --- a/LICENSE +++ b/LICENSE @@ -1,13 +1,3 @@ -Employer mandated disclaimer: - - I am providing code in the repository to you under an open source license. - Because this is my personal repository, the license you receive to my code is - from me and other individual contributors, and not my employer (Facebook). - - - Vidar "koala_man" Holen - ----- - GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 From a524929b6920ed4950b5bf5a97c57a40dd9b09f5 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Wed, 12 Oct 2022 20:21:48 -0700 Subject: [PATCH 066/244] Remove outdated test --- src/ShellCheck/Analytics.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index bf77c9c..e8bc4b9 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -3575,7 +3575,6 @@ prop_checkPipeToNowhere4 = verify checkPipeToNowhere "printf 'Lol' << eof\nlol\n prop_checkPipeToNowhere5 = verifyNot checkPipeToNowhere "echo foo | xargs du" prop_checkPipeToNowhere6 = verifyNot checkPipeToNowhere "ls | echo $(cat)" prop_checkPipeToNowhere7 = verifyNot checkPipeToNowhere "echo foo | var=$(cat) ls" -prop_checkPipeToNowhere8 = verify checkPipeToNowhere "foo | true" prop_checkPipeToNowhere9 = verifyNot checkPipeToNowhere "mv -i f . < /dev/stdin" prop_checkPipeToNowhere10 = verify checkPipeToNowhere "ls > file | grep foo" prop_checkPipeToNowhere11 = verify checkPipeToNowhere "ls | grep foo < file" From 14056a7f3a5917cba81582b33624948e83d7a50d Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Wed, 12 Oct 2022 20:20:59 -0700 Subject: [PATCH 067/244] Don't suggest pgrep for `ps -p .. | grep` (fixes #2597) --- src/ShellCheck/Analytics.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e8bc4b9..77c527f 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -550,6 +550,7 @@ prop_checkPipePitfalls19 = verifyNot checkPipePitfalls "foo | grep -A2 bar | wc prop_checkPipePitfalls20 = verifyNot checkPipePitfalls "foo | grep -B999 bar | wc -l" prop_checkPipePitfalls21 = verifyNot checkPipePitfalls "foo | grep --after-context 999 bar | wc -l" prop_checkPipePitfalls22 = verifyNot checkPipePitfalls "foo | grep -B 1 --after-context 999 bar | wc -l" +prop_checkPipePitfalls23 = verifyNot checkPipePitfalls "ps -o pid,args -p $(pgrep java) | grep -F net.shellcheck.Test" checkPipePitfalls _ (T_Pipeline id _ commands) = do for ["find", "xargs"] $ \(find:xargs:_) -> @@ -563,8 +564,15 @@ checkPipePitfalls _ (T_Pipeline id _ commands) = do ]) $ warn (getId find) 2038 "Use -print0/-0 or -exec + to allow for non-alphanumeric filenames." - for' ["ps", "grep"] $ - \x -> info x 2009 "Consider using pgrep instead of grepping ps output." + for ["ps", "grep"] $ + \(ps:grep:_) -> + let + psFlags = maybe [] (map snd . getAllFlags) $ getCommand ps + in + -- There are many ways to specify a pid: 1, -1, p 1, wup 1, -q 1, -p 1, --pid 1. + -- For simplicity we only deal with the most canonical looking flags: + unless (any (`elem` ["p", "pid", "q", "quick-pid"]) psFlags) $ + info (getId ps) 2009 "Consider using pgrep instead of grepping ps output." for ["grep", "wc"] $ \(grep:wc:_) -> @@ -782,6 +790,7 @@ prop_checkUnquotedExpansions7 = verifyNot checkUnquotedExpansions "cat << foo\n$ prop_checkUnquotedExpansions8 = verifyNot checkUnquotedExpansions "set -- $(seq 1 4)" prop_checkUnquotedExpansions9 = verifyNot checkUnquotedExpansions "echo foo `# inline comment`" prop_checkUnquotedExpansions10 = verify checkUnquotedExpansions "#!/bin/sh\nexport var=$(val)" +prop_checkUnquotedExpansions11 = verifyNot checkUnquotedExpansions "ps -p $(pgrep foo)" checkUnquotedExpansions params = check where @@ -795,7 +804,7 @@ checkUnquotedExpansions params = warn (getId t) 2046 "Quote this to prevent word splitting." shouldBeSplit t = - getCommandNameFromExpansion t == Just "seq" + getCommandNameFromExpansion t `elem` [Just "seq", Just "pgrep"] prop_checkRedirectToSame = verify checkRedirectToSame "cat foo > foo" From d9c9e60fb0064a45188dd93993ad86253ac5a0b3 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 13 Oct 2022 19:46:15 -0700 Subject: [PATCH 068/244] Allow arbitrary bats @test names (fixes #2587) --- src/ShellCheck/AST.hs | 2 +- src/ShellCheck/Parser.hs | 19 ++++++++++++++++--- 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/AST.hs b/src/ShellCheck/AST.hs index ca5007a..5c20416 100644 --- a/src/ShellCheck/AST.hs +++ b/src/ShellCheck/AST.hs @@ -142,7 +142,7 @@ data InnerToken t = | Inner_T_CoProcBody t | Inner_T_Include t | Inner_T_SourceCommand t t - | Inner_T_BatsTest t t + | Inner_T_BatsTest String t deriving (Show, Eq, Functor, Foldable, Traversable) data Annotation = diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index aeaf703..969f4b7 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -2500,16 +2500,29 @@ readBraceGroup = called "brace group" $ do spacing return $ T_BraceGroup id list -prop_readBatsTest = isOk readBatsTest "@test 'can parse' {\n true\n}" +prop_readBatsTest1 = isOk readBatsTest "@test 'can parse' {\n true\n}" +prop_readBatsTest2 = isOk readBatsTest "@test random text !(@*$Y&! {\n true\n}" +prop_readBatsTest3 = isOk readBatsTest "@test foo { bar { baz {\n true\n}" +prop_readBatsTest4 = isNotOk readBatsTest "@test foo \n{\n true\n}" readBatsTest = called "bats @test" $ do start <- startSpan - try $ string "@test" + try $ string "@test " spacing - name <- readNormalWord + name <- readBatsName spacing test <- readBraceGroup id <- endSpan start return $ T_BatsTest id name test + where + readBatsName = do + line <- try . lookAhead $ many1 $ noneOf "\n" + let name = reverse $ f $ reverse line + string name + + -- We want everything before the last " {" in a string, so we find everything after "{ " in its reverse + f ('{':' ':rest) = dropWhile isSpace rest + f (a:rest) = f rest + f [] = "" prop_readWhileClause = isOk readWhileClause "while [[ -e foo ]]; do sleep 1; done" readWhileClause = called "while loop" $ do From b770984dfcfb90d74b2ca7c1ad11cd35bb45d45e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 13 Oct 2022 21:04:38 -0700 Subject: [PATCH 069/244] Try to parse the inside of traps (fixes #2584) --- src/ShellCheck/Parser.hs | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 969f4b7..837735a 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -2112,6 +2112,7 @@ prop_readSimpleCommand11 = isOk readSimpleCommand "/\\* foo" prop_readSimpleCommand12 = isWarning readSimpleCommand "elsif foo" prop_readSimpleCommand13 = isWarning readSimpleCommand "ElseIf foo" prop_readSimpleCommand14 = isWarning readSimpleCommand "elseif[$i==2]" +prop_readSimpleCommand15 = isWarning readSimpleCommand "trap 'foo\"bar' INT" readSimpleCommand = called "simple command" $ do prefix <- option [] readCmdPrefix skipAnnotationAndWarn @@ -2141,9 +2142,12 @@ readSimpleCommand = called "simple command" $ do id2 <- getNewIdFor id1 let result = makeSimpleCommand id1 id2 prefix [cmd] suffix - if isCommand ["source", "."] cmd - then readSource result - else return result + case () of + _ | isCommand ["source", "."] cmd -> readSource result + _ | isCommand ["trap"] cmd -> do + syntaxCheckTrap result + return result + _ -> return result where isCommand strings (T_NormalWord _ [T_Literal _ s]) = s `elem` strings isCommand _ _ = False @@ -2163,6 +2167,17 @@ readSimpleCommand = called "simple command" $ do parseProblemAtId (getId cmd) ErrorC 1131 "Use 'elif' to start another branch." _ -> return () + syntaxCheckTrap cmd = + case cmd of + (T_Redirecting _ _ (T_SimpleCommand _ _ (cmd:arg:_))) -> checkArg arg (getLiteralString arg) + _ -> return () + where + checkArg _ Nothing = return () + checkArg arg (Just ('-':_)) = return () + checkArg arg (Just str) = do + (start,end) <- getSpanForId (getId arg) + subParse start (tryWithErrors (readCompoundListOrEmpty >> verifyEof) <|> return ()) str + commentWarning id = parseProblemAtId id ErrorC 1127 "Was this intended as a comment? Use # in sh." From 86e2b76730bef5ec509828d138c67d6b49b89b7f Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 29 Oct 2022 12:50:07 -0700 Subject: [PATCH 070/244] Improve SC1059 error message --- src/ShellCheck/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 837735a..dd0f0f0 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -2566,7 +2566,7 @@ readDoGroup kwId = do parseProblem ErrorC 1058 "Expected 'do'." return "Expected 'do'" - acceptButWarn g_Semi ErrorC 1059 "No semicolons directly after 'do'." + acceptButWarn g_Semi ErrorC 1059 "Semicolon is not allowed directly after 'do'. You can just delete it." allspacing optional (do From 84d8530f14e35ff3fb7688fb11935b60b02deaf0 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 29 Oct 2022 12:50:37 -0700 Subject: [PATCH 071/244] Add SVG logo --- doc/shellcheck_logo.svg | 294 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 294 insertions(+) create mode 100644 doc/shellcheck_logo.svg diff --git a/doc/shellcheck_logo.svg b/doc/shellcheck_logo.svg new file mode 100644 index 0000000..836aa63 --- /dev/null +++ b/doc/shellcheck_logo.svg @@ -0,0 +1,294 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From 3342902d9a354c71ba72a939af82d535f043d079 Mon Sep 17 00:00:00 2001 From: ArenM Date: Thu, 17 Nov 2022 18:06:10 -0500 Subject: [PATCH 072/244] Warn about 'read' without a variable in POSIX sh Dash throws an error if the read command isn't supplied a variable name. --- src/ShellCheck/Checks/ShellSupport.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 30a19b9..eda6882 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -184,6 +184,10 @@ prop_checkBashisms96 = verifyNot checkBashisms "#!/bin/dash\necho $_" prop_checkBashisms97 = verify checkBashisms "#!/bin/sh\necho ${var,}" prop_checkBashisms98 = verify checkBashisms "#!/bin/sh\necho ${var^^}" prop_checkBashisms99 = verify checkBashisms "#!/bin/dash\necho [^f]oo" +prop_checkBashisms100 = verify checkBashisms "read -r" +prop_checkBashisms101 = verify checkBashisms "read" +prop_checkBashisms102 = verifyNot checkBashisms "read -r foo" +prop_checkBashisms103 = verifyNot checkBashisms "read foo" checkBashisms = ForShell [Sh, Dash] $ \t -> do params <- ask kludge params t @@ -284,6 +288,13 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do argString = concat $ oversimplify arg flagRegex = mkRegex "^-[eEsn]+$" + bashism t@(T_SimpleCommand _ _ (cmd:args)) + | t `isCommand` "read" && length (onlyNames args) == 0 = + warnMsg (getId cmd) 3061 "read without a variable is" + where + notFlag arg = head (concat $ oversimplify arg) /= '-' + onlyNames = filter (notFlag) + bashism t@(T_SimpleCommand _ _ (cmd:arg:_)) | getLiteralString cmd == Just "exec" && "-" `isPrefixOf` concat (oversimplify arg) = warnMsg (getId arg) 3038 "exec flags are" From 2a16a4e8c18745887ca33c545854bdcb3097fede Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 10 Dec 2022 10:46:49 -0800 Subject: [PATCH 073/244] Add missing imports for later GHC versions --- ShellCheck.cabal | 9 ++++++--- shellcheck.hs | 2 ++ src/ShellCheck/AnalyzerLib.hs | 1 + src/ShellCheck/Fixer.hs | 1 + 4 files changed, 10 insertions(+), 3 deletions(-) diff --git a/ShellCheck.cabal b/ShellCheck.cabal index b22b5c8..abb32d0 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -54,11 +54,12 @@ library Diff >= 0.2.0, directory >= 1.2.3.0, fgl, - mtl >= 2.2.1, filepath, + mtl >= 2.2.1, parsec, - regex-tdfa, QuickCheck >= 2.7.4, + regex-tdfa, + transformers, -- When cabal supports it, move this to setup-depends: process exposed-modules: @@ -112,6 +113,7 @@ executable shellcheck parsec >= 3.0, QuickCheck >= 2.7.4, regex-tdfa, + transformers, ShellCheck default-language: Haskell98 main-is: shellcheck.hs @@ -128,11 +130,12 @@ test-suite test-shellcheck Diff >= 0.2.0, directory >= 1.2.3.0, fgl, - mtl >= 2.2.1, filepath, + mtl >= 2.2.1, parsec, QuickCheck >= 2.7.4, regex-tdfa, + transformers, ShellCheck default-language: Haskell98 main-is: test/shellcheck.hs diff --git a/shellcheck.hs b/shellcheck.hs index a525251..4e8a155 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -34,6 +34,8 @@ import qualified ShellCheck.Formatter.Quiet import Control.Exception import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Class import Control.Monad.Except import Data.Bits import Data.Char diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 444c751..47ea91d 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -32,6 +32,7 @@ import ShellCheck.Regex import Control.Arrow (first) import Control.DeepSeq +import Control.Monad import Control.Monad.Identity import Control.Monad.RWS import Control.Monad.State diff --git a/src/ShellCheck/Fixer.hs b/src/ShellCheck/Fixer.hs index 358dec9..0d3c8f4 100644 --- a/src/ShellCheck/Fixer.hs +++ b/src/ShellCheck/Fixer.hs @@ -23,6 +23,7 @@ module ShellCheck.Fixer (applyFix, removeTabStops, mapPositions, Ranged(..), run import ShellCheck.Interface import ShellCheck.Prelude +import Control.Monad import Control.Monad.State import Data.Array import Data.List From 495e34d10179715e8a675ca3e721b47757c9dc0f Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 11 Dec 2022 14:18:47 -0800 Subject: [PATCH 074/244] Add missing Semigroup import for older GHC --- src/ShellCheck/Prelude.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/ShellCheck/Prelude.hs b/src/ShellCheck/Prelude.hs index 7e9011b..7610c46 100644 --- a/src/ShellCheck/Prelude.hs +++ b/src/ShellCheck/Prelude.hs @@ -21,6 +21,9 @@ -- Generic basic utility functions module ShellCheck.Prelude where +import Data.Semigroup + + -- Get element 0 or a default. Like `head` but safe. headOrDefault _ (a:_) = a headOrDefault def _ = def From 74b1745a1998c5b0a203a5d3c67dade7997ad1b2 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 11 Dec 2022 14:48:00 -0800 Subject: [PATCH 075/244] Fix compiler error on some GHC versions Fixes the following error: src/ShellCheck/CFGAnalysis.hs:1394:40: error: * Couldn't match expected type `[S.Set a]' with actual type `M.Map String FunctionValue' * In the second argument of `($)', namely `mapStorage $ sFunctionTargets state' In the expression: S.unions $ mapStorage $ sFunctionTargets state In an equation for `declaredFuncs': declaredFuncs = S.unions $ mapStorage $ sFunctionTargets state * Relevant bindings include declaredFuncs :: S.Set a (bound at src/ShellCheck/CFGAnalysis.hs:1394:13) --- src/ShellCheck/CFGAnalysis.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 7b270a8..cac913e 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -1391,7 +1391,7 @@ analyzeControlFlow params t = getFunctionTargets :: InternalState -> M.Map Node FunctionDefinition getFunctionTargets state = let - declaredFuncs = S.unions $ mapStorage $ sFunctionTargets state + declaredFuncs = S.unions $ M.elems $ mapStorage $ sFunctionTargets state getFunc d = case d of FunctionDefinition _ entry _ -> Just (entry, d) From 3cae6cd6abe16b18a1c95598561d5afca1135cec Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 11 Dec 2022 15:05:33 -0800 Subject: [PATCH 076/244] Allow building on deepseq < 1.4.2.0 --- src/ShellCheck/CFGAnalysis.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index cac913e..4e36cf5 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -20,6 +20,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DeriveAnyClass, DeriveGeneric #-} +{-# LANGUAGE CPP #-} {- Data Flow Analysis on a Control Flow Graph. @@ -433,6 +434,13 @@ data StackEntry s = StackEntry { } deriving (Eq, Generic, NFData) +#if MIN_VERSION_deepseq(1,4,2) +-- Our deepseq already has a STRef instance +#else +-- Older deepseq (for GHC < 8) lacks this instance +instance NFData (STRef s a) where + rnf = (`seq` ()) +#endif -- Overwrite a base state with the contents of a diff state -- This is unrelated to join/merge. From 985ca2530d475f6bf93fa81d31cc220fccddeea8 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 11 Dec 2022 16:34:29 -0800 Subject: [PATCH 077/244] Add Docker testing for older and newer Ubuntu versions --- test/buildtest | 3 ++- test/distrotest | 3 +++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/test/buildtest b/test/buildtest index 1d194fc..469539b 100755 --- a/test/buildtest +++ b/test/buildtest @@ -22,7 +22,8 @@ fi cabal install --dependencies-only --enable-tests "${flags[@]}" || cabal install --dependencies-only "${flags[@]}" || - die "can't install dependencies" + cabal install --dependencies-only --max-backjumps -1 "${flags[@]}" || + die "can't install dependencies" cabal configure --enable-tests "${flags[@]}" || die "configure failed" cabal build || diff --git a/test/distrotest b/test/distrotest index 464768c..e1711ea 100755 --- a/test/distrotest +++ b/test/distrotest @@ -67,7 +67,10 @@ fedora:latest dnf install -y cabal-install ghc-template-haskell-devel fi archlinux:latest pacman -S -y --noconfirm cabal-install ghc-static base-devel # Ubuntu LTS +ubuntu:22.04 apt-get update && apt-get install -y cabal-install ubuntu:20.04 apt-get update && apt-get install -y cabal-install +ubuntu:18.04 apt-get update && apt-get install -y cabal-install +ubuntu:16.04 apt-get update && apt-get install -y cabal-install # Stack on Ubuntu LTS ubuntu:20.04 set -e; apt-get update && apt-get install -y curl && curl -sSL https://get.haskellstack.org/ | sh -s - -f && cd /mnt && exec test/stacktest From 8754c21244ada70c070763644044fa166387f708 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 11 Dec 2022 16:37:49 -0800 Subject: [PATCH 078/244] Avoid $ trigger TH --- src/ShellCheck/Formatter/CheckStyle.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Formatter/CheckStyle.hs b/src/ShellCheck/Formatter/CheckStyle.hs index c79ac21..6ad6c9c 100644 --- a/src/ShellCheck/Formatter/CheckStyle.hs +++ b/src/ShellCheck/Formatter/CheckStyle.hs @@ -88,7 +88,7 @@ outputError file error = putStrLn $ concat [ attr s v = concat [ s, "='", escape v, "' " ] escape = concatMap escape' escape' c = if isOk c then [c] else "&#" ++ show (ord c) ++ ";" -isOk x = any ($x) [isAsciiUpper, isAsciiLower, isDigit, (`elem` " ./")] +isOk x = any ($ x) [isAsciiUpper, isAsciiLower, isDigit, (`elem` " ./")] severity "error" = "error" severity "warning" = "warning" From a7c5be93dcbd4c219615e44030073158df4426e5 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 11 Dec 2022 12:29:05 -0800 Subject: [PATCH 079/244] Tighten bounds on packages --- ShellCheck.cabal | 61 ++++++++++++++++++++++++++---------------------- 1 file changed, 33 insertions(+), 28 deletions(-) diff --git a/ShellCheck.cabal b/ShellCheck.cabal index abb32d0..dab588c 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -45,21 +45,26 @@ library build-depends: semigroups build-depends: - aeson, - array, - base >= 4.8.0.0 && < 5, - bytestring, - containers >= 0.5, - deepseq >= 1.4.0.0, - Diff >= 0.2.0, - directory >= 1.2.3.0, - fgl, - filepath, - mtl >= 2.2.1, - parsec, - QuickCheck >= 2.7.4, - regex-tdfa, - transformers, + -- The lower bounds are based on GHC 7.10.3 + -- The upper bounds are based on GHC 9.4.3 + aeson >= 1.4.0 && < 2.2, + array >= 0.5.1 && < 0.6, + base >= 4.8.0.0 && < 5, + bytestring >= 0.10.6 && < 0.12, + containers >= 0.5.6 && < 0.7, + deepseq >= 1.4.1 && < 1.5, + Diff >= 0.4.0 && < 0.5, + fgl >= 5.7.0 && < 5.9, + filepath >= 1.4.0 && < 1.5, + mtl >= 2.2.2 && < 2.3, + parsec >= 3.1.14 && < 3.2, + QuickCheck >= 2.14.2 && < 2.15, + regex-tdfa >= 1.2.0 && < 1.4, + transformers >= 0.4.2 && < 0.6, + + -- getXdgDirectory from 1.2.3.0 + directory >= 1.2.3 && < 1.4, + -- When cabal supports it, move this to setup-depends: process exposed-modules: @@ -101,17 +106,17 @@ executable shellcheck build-depends: aeson, array, - base >= 4 && < 5, + base, bytestring, containers, - deepseq >= 1.4.0.0, - Diff >= 0.2.0, - directory >= 1.2.3.0, + deepseq, + Diff, + directory, fgl, - mtl >= 2.2.1, + mtl, filepath, - parsec >= 3.0, - QuickCheck >= 2.7.4, + parsec, + QuickCheck, regex-tdfa, transformers, ShellCheck @@ -123,17 +128,17 @@ test-suite test-shellcheck build-depends: aeson, array, - base >= 4 && < 5, + base, bytestring, containers, - deepseq >= 1.4.0.0, - Diff >= 0.2.0, - directory >= 1.2.3.0, + deepseq, + Diff, + directory, fgl, filepath, - mtl >= 2.2.1, + mtl, parsec, - QuickCheck >= 2.7.4, + QuickCheck, regex-tdfa, transformers, ShellCheck From 7cfcf6db8a3d5a15cfd361293bbbe2d38d473c5e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 11 Dec 2022 19:22:42 -0800 Subject: [PATCH 080/244] Fix stack build --- test/distrotest | 2 +- test/stacktest | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/test/distrotest b/test/distrotest index e1711ea..53a40a7 100755 --- a/test/distrotest +++ b/test/distrotest @@ -73,7 +73,7 @@ ubuntu:18.04 apt-get update && apt-get install -y cabal-install ubuntu:16.04 apt-get update && apt-get install -y cabal-install # Stack on Ubuntu LTS -ubuntu:20.04 set -e; apt-get update && apt-get install -y curl && curl -sSL https://get.haskellstack.org/ | sh -s - -f && cd /mnt && exec test/stacktest +ubuntu:22.04 set -e; apt-get update && apt-get install -y curl && curl -sSL https://get.haskellstack.org/ | sh -s - -f && cd /mnt && exec test/stacktest EOF exit "$final" diff --git a/test/stacktest b/test/stacktest index ae04f1b..9eb8d1e 100755 --- a/test/stacktest +++ b/test/stacktest @@ -3,7 +3,7 @@ # various resolvers. It's run via distrotest. resolvers=( - nightly-"$(date -d "3 days ago" +"%Y-%m-%d")" +# nightly-"$(date -d "3 days ago" +"%Y-%m-%d")" ) die() { echo "$*" >&2; exit 1; } From ae199edb680dd416790b7890fa52e64a11f2b4af Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 11 Dec 2022 20:50:33 -0800 Subject: [PATCH 081/244] Let distrotest fail fast when there remaining executables --- test/distrotest | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/test/distrotest b/test/distrotest index 53a40a7..4ad66f8 100755 --- a/test/distrotest +++ b/test/distrotest @@ -25,6 +25,13 @@ exit 0 echo "Deleting 'dist' and 'dist-newstyle'..." rm -rf dist dist-newstyle +execs=$(find . -name shellcheck) + +if [ -n "$execs" ] +then + die "Found unexpected executables. Remove and try again: $execs" +fi + log=$(mktemp) || die "Can't create temp file" date >> "$log" || die "Can't write to log" From 8c5fdc3522236767e9ce840b57da2a13b32eb4ed Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 12 Dec 2022 21:49:01 -0800 Subject: [PATCH 082/244] Update copyright years --- shellcheck.1.md | 2 +- src/ShellCheck/Analytics.hs | 2 +- src/ShellCheck/Analyzer.hs | 2 +- src/ShellCheck/AnalyzerLib.hs | 2 +- src/ShellCheck/Checker.hs | 2 +- src/ShellCheck/Checks/Commands.hs | 2 +- src/ShellCheck/Parser.hs | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/shellcheck.1.md b/shellcheck.1.md index c345a2b..9675e79 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -378,7 +378,7 @@ long list of wonderful contributors. # COPYRIGHT -Copyright 2012-2021, Vidar Holen and contributors. +Copyright 2012-2022, Vidar Holen and contributors. Licensed under the GNU General Public License version 3 or later, see https://gnu.org/licenses/gpl.html diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index f50510d..1f6d96d 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1,5 +1,5 @@ {- - Copyright 2012-2021 Vidar Holen + Copyright 2012-2022 Vidar Holen This file is part of ShellCheck. https://www.shellcheck.net diff --git a/src/ShellCheck/Analyzer.hs b/src/ShellCheck/Analyzer.hs index 06b6e53..53717ed 100644 --- a/src/ShellCheck/Analyzer.hs +++ b/src/ShellCheck/Analyzer.hs @@ -1,5 +1,5 @@ {- - Copyright 2012-2019 Vidar Holen + Copyright 2012-2022 Vidar Holen This file is part of ShellCheck. https://www.shellcheck.net diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 47ea91d..ca928fd 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -1,5 +1,5 @@ {- - Copyright 2012-2021 Vidar Holen + Copyright 2012-2022 Vidar Holen This file is part of ShellCheck. https://www.shellcheck.net diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index c8d2c39..b56be68 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -1,5 +1,5 @@ {- - Copyright 2012-2020 Vidar Holen + Copyright 2012-2022 Vidar Holen This file is part of ShellCheck. https://www.shellcheck.net diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index e97ecd6..691836f 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -1,5 +1,5 @@ {- - Copyright 2012-2021 Vidar Holen + Copyright 2012-2022 Vidar Holen This file is part of ShellCheck. https://www.shellcheck.net diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index dd0f0f0..7a50967 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -1,5 +1,5 @@ {- - Copyright 2012-2021 Vidar Holen + Copyright 2012-2022 Vidar Holen This file is part of ShellCheck. https://www.shellcheck.net From a526ee08290cc127bc1aa5a05e9b927af87b6ef3 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 12 Dec 2022 19:58:11 -0800 Subject: [PATCH 083/244] Stable version 0.9.0 This release is dedicated to Mindustry: the most fun you can have with open source (outside of shell scripting of course). --- CHANGELOG.md | 2 +- ShellCheck.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c363eb5..57951c8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,4 @@ -## Git +## v0.9.0 - 2022-12-12 ### Added - SC2316: Warn about 'local readonly foo' and similar (thanks, patrickxia!) - SC2317: Warn about unreachable commands diff --git a/ShellCheck.cabal b/ShellCheck.cabal index dab588c..1226588 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -1,5 +1,5 @@ Name: ShellCheck -Version: 0.8.0 +Version: 0.9.0 Synopsis: Shell script analysis tool License: GPL-3 License-file: LICENSE From 5a3eb89e385d3667ecda33cfe769571ffc9dd7a3 Mon Sep 17 00:00:00 2001 From: Samuel Lijin Date: Fri, 3 Feb 2023 09:17:47 -0800 Subject: [PATCH 084/244] Document Trunk Check integration Trunk Check is a universal linter which integrates with a wide variety of linters and formatters, `shellcheck` included. We're big fans of `shellcheck` and figured that you might find our tool to be interesting enough to include it in the integrations list. --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index 6f3e4a9..8cf3584 100644 --- a/README.md +++ b/README.md @@ -112,6 +112,7 @@ Services and platforms that have ShellCheck pre-installed and ready to use: * [Code Factor](https://www.codefactor.io/) * [CircleCI](https://circleci.com) via the [ShellCheck Orb](https://circleci.com/orbs/registry/orb/circleci/shellcheck) * [Github](https://github.com/features/actions) (only Linux) +* [Trunk Check](https://trunk.io/products/check) (universal linter; [allows you to explicitly version your shellcheck install](https://github.com/trunk-io/plugins/blob/bcbb361dcdbe4619af51ea7db474d7fb87540d20/.trunk/trunk.yaml#L32)) via the [shellcheck plugin](https://github.com/trunk-io/plugins/blob/main/linters/shellcheck/plugin.yaml) Most other services, including [GitLab](https://about.gitlab.com/), let you install ShellCheck yourself, either through the system's package manager (see [Installing](#installing)), From 78dea1d4f93987c7e52df121f8062da3387d0f2e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 Feb 2023 10:27:59 -0800 Subject: [PATCH 085/244] Update changelog from release --- CHANGELOG.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 57951c8..fc1c0ce 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## Git +### Added + +### Fixed + +### Changed + + ## v0.9.0 - 2022-12-12 ### Added - SC2316: Warn about 'local readonly foo' and similar (thanks, patrickxia!) From 2842ce97b88a9cd9551f5f42f67a97e17a523b53 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 Feb 2023 11:38:20 -0800 Subject: [PATCH 086/244] Remove fgl-5.8.1.0 as a dependency ShellCheck is temporarily broken by https://github.com/haskell/fgl/commit/c8f56c18242b0c3e916892c5db56a609ec396637 --- ShellCheck.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ShellCheck.cabal b/ShellCheck.cabal index 1226588..8afebe1 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -54,7 +54,7 @@ library containers >= 0.5.6 && < 0.7, deepseq >= 1.4.1 && < 1.5, Diff >= 0.4.0 && < 0.5, - fgl >= 5.7.0 && < 5.9, + fgl >= 5.7.0 && < 5.8.1.0, filepath >= 1.4.0 && < 1.5, mtl >= 2.2.2 && < 2.3, parsec >= 3.1.14 && < 3.2, From c05380d518056189412e12128a8906b8ca6f6717 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 Feb 2023 13:19:27 -0800 Subject: [PATCH 087/244] Count CFEExit as control flow for the purposes of finding dominators --- src/ShellCheck/CFG.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index e0c6267..f882adc 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -192,7 +192,7 @@ buildGraph params root = base idToRange = M.fromList mapping - isRealEdge (from, to, edge) = case edge of CFEFlow -> True; _ -> False + isRealEdge (from, to, edge) = case edge of CFEFlow -> True; CFEExit -> True; _ -> False onlyRealEdges = filter isRealEdge edges (_, mainExit) = fromJust $ M.lookup (getId root) idToRange @@ -1301,7 +1301,10 @@ findPostDominators mainexit graph = asArray reversed = grev withExitEdges postDoms = dom reversed mainexit (_, maxNode) = nodeRange graph - asArray = array (0, maxNode) postDoms + -- Holes in the array cause "Exception: (Array.!): undefined array element" while + -- inspecting/debugging, so fill the array first and then update. + initializedArray = listArray (0, maxNode) $ repeat [] + asArray = initializedArray // postDoms return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) From b1ca3929e387446f3e3db023d716cf3787370437 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 Feb 2023 19:55:25 -0800 Subject: [PATCH 088/244] Upgrade cross-compilers to 9.2.5 to handle hashable-1.4.2.0 --- build/darwin.x86_64/Dockerfile | 11 +++++++---- build/linux.aarch64/Dockerfile | 14 ++++++++++---- 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/build/darwin.x86_64/Dockerfile b/build/darwin.x86_64/Dockerfile index 9e33a82..a53245f 100644 --- a/build/darwin.x86_64/Dockerfile +++ b/build/darwin.x86_64/Dockerfile @@ -6,15 +6,18 @@ ENV TARGETNAME darwin.x86_64 # Build dependencies USER root ENV DEBIAN_FRONTEND noninteractive -RUN apt-get update && apt-get install -y ghc automake autoconf llvm curl +RUN sed -e 's/focal/kinetic/g' -i /etc/apt/sources.list +RUN apt-get update +RUN apt-get dist-upgrade -y +RUN apt-get install -y ghc automake autoconf llvm curl alex happy # Build GHC WORKDIR /ghc -RUN curl -L "https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-src.tar.xz" | tar xJ --strip-components=1 -RUN ./boot && ./configure --host x86_64-linux-gnu --build x86_64-linux-gnu --target "$TARGET" +RUN curl -L "https://downloads.haskell.org/~ghc/9.2.5/ghc-9.2.5-src.tar.xz" | tar xJ --strip-components=1 +RUN ./configure --host x86_64-linux-gnu --build x86_64-linux-gnu --target "$TARGET" RUN cp mk/flavours/quick-cross.mk mk/build.mk && make -j "$(nproc)" RUN make install -RUN curl -L "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-unknown-linux.tar.xz" | tar xJv -C /usr/local/bin +RUN curl -L "https://downloads.haskell.org/~cabal/cabal-install-3.9.0.0/cabal-install-3.9-x86_64-linux-alpine.tar.xz" | tar xJv -C /usr/local/bin # Due to an apparent cabal bug, we specify our options directly to cabal # It won't reuse caches if ghc-options are specified in ~/.cabal/config diff --git a/build/linux.aarch64/Dockerfile b/build/linux.aarch64/Dockerfile index 60537b3..d5320e9 100644 --- a/build/linux.aarch64/Dockerfile +++ b/build/linux.aarch64/Dockerfile @@ -6,19 +6,25 @@ ENV TARGETNAME linux.aarch64 # Build dependencies USER root ENV DEBIAN_FRONTEND noninteractive -RUN apt-get update && apt-get install -y ghc automake autoconf build-essential llvm curl qemu-user-static gcc-$TARGET + +# These deps are from 20.04, because GHC's compiler/llvm support moves slowly +RUN apt-get update && apt-get install -y llvm gcc-$TARGET + +# The rest are from 22.10 +RUN sed -e 's/focal/kinetic/g' -i /etc/apt/sources.list +RUN apt-get update && apt-get install -y ghc alex happy automake autoconf build-essential curl qemu-user-static # Build GHC WORKDIR /ghc -RUN curl -L "https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-src.tar.xz" | tar xJ --strip-components=1 +RUN curl -L "https://downloads.haskell.org/~ghc/9.2.5/ghc-9.2.5-src.tar.xz" | tar xJ --strip-components=1 RUN ./boot && ./configure --host x86_64-linux-gnu --build x86_64-linux-gnu --target "$TARGET" RUN cp mk/flavours/quick-cross.mk mk/build.mk && make -j "$(nproc)" RUN make install -RUN curl -L "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-unknown-linux.tar.xz" | tar xJv -C /usr/local/bin +RUN curl -L "https://downloads.haskell.org/~cabal/cabal-install-3.9.0.0/cabal-install-3.9-x86_64-linux-alpine.tar.xz" | tar xJv -C /usr/local/bin # Due to an apparent cabal bug, we specify our options directly to cabal # It won't reuse caches if ghc-options are specified in ~/.cabal/config -ENV CABALOPTS "--ghc-options;-split-sections -optc-Os -optc-Wl,--gc-sections;--with-ghc=$TARGET-ghc;--with-hc-pkg=$TARGET-ghc-pkg" +ENV CABALOPTS "--ghc-options;-split-sections -optc-Os -optc-Wl,--gc-sections -optc-fPIC;--with-ghc=$TARGET-ghc;--with-hc-pkg=$TARGET-ghc-pkg" # Prebuild the dependencies RUN cabal update && IFS=';' && cabal install --dependencies-only $CABALOPTS ShellCheck From e6e8ab0415f720afee5f426b6ca09757a4ed12ce Mon Sep 17 00:00:00 2001 From: Felipe Santos Date: Sun, 5 Feb 2023 11:13:07 -0300 Subject: [PATCH 089/244] Mention VS Code ShellCheck binaries distribution --- README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index 6f3e4a9..a1c59a7 100644 --- a/README.md +++ b/README.md @@ -232,6 +232,8 @@ Alternatively, you can download pre-compiled binaries for the latest release her or see the [GitHub Releases](https://github.com/koalaman/shellcheck/releases) for other releases (including the [latest](https://github.com/koalaman/shellcheck/releases/tag/latest) meta-release for daily git builds). +You can also find pre-compiled binaries repackaged in `.tar.gz` format in the [VS Code ShellCheck Binaries](https://github.com/vscode-shellcheck/shellcheck-binaries/releases) repository. It also includes a pre-compiled binary for **Apple M1** processors. + Distro packages already come with a `man` page. If you are building from source, it can be installed with: ```console From 08b437974e871d82213545b9a079bcb794f7a58a Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 23 Apr 2023 16:47:49 -0700 Subject: [PATCH 090/244] Rewrite vscode-shellcheck blurb --- README.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index a1c59a7..3a839aa 100644 --- a/README.md +++ b/README.md @@ -232,7 +232,8 @@ Alternatively, you can download pre-compiled binaries for the latest release her or see the [GitHub Releases](https://github.com/koalaman/shellcheck/releases) for other releases (including the [latest](https://github.com/koalaman/shellcheck/releases/tag/latest) meta-release for daily git builds). -You can also find pre-compiled binaries repackaged in `.tar.gz` format in the [VS Code ShellCheck Binaries](https://github.com/vscode-shellcheck/shellcheck-binaries/releases) repository. It also includes a pre-compiled binary for **Apple M1** processors. +There are currently no official binaries for Apple Silicon, but third party builds are available via +[ShellCheck for Visual Studio Code](https://github.com/vscode-shellcheck/shellcheck-binaries/releases). Distro packages already come with a `man` page. If you are building from source, it can be installed with: From 1164aa4efc225129302e2a2450e907ad842d41e4 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 23 Apr 2023 19:35:54 -0700 Subject: [PATCH 091/244] Installing custom docker should no longer be necessary for buildx --- .multi_arch_docker | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/.multi_arch_docker b/.multi_arch_docker index a9f7401..1c5d32b 100755 --- a/.multi_arch_docker +++ b/.multi_arch_docker @@ -3,28 +3,10 @@ # binaries previously built and deployed to GitHub. function multi_arch_docker::install_docker_buildx() { - # Install up-to-date version of docker, with buildx support. - local -r docker_apt_repo='https://download.docker.com/linux/ubuntu' - curl -fsSL "${docker_apt_repo}/gpg" | sudo apt-key add - - local -r os="$(lsb_release -cs)" - sudo add-apt-repository "deb [arch=amd64] $docker_apt_repo $os stable" - sudo apt-get update - sudo apt-get -y -o Dpkg::Options::="--force-confnew" install docker-ce - - # Enable docker daemon experimental support (for 'pull --platform'). - local -r config='/etc/docker/daemon.json' - if [[ -e "$config" ]]; then - sudo sed -i -e 's/{/{ "experimental": true, /' "$config" - else - echo '{ "experimental": true }' | sudo tee "$config" - fi - sudo systemctl restart docker - # Install QEMU multi-architecture support for docker buildx. docker run --rm --privileged multiarch/qemu-user-static --reset -p yes # Instantiate docker buildx builder with multi-architecture support. - export DOCKER_CLI_EXPERIMENTAL=enabled docker buildx create --name mybuilder docker buildx use mybuilder # Start up buildx and verify that all is OK. From 5fec3f9b34bc0ba3d2d02d4a7613cb3a62ed4c15 Mon Sep 17 00:00:00 2001 From: James Morris Date: Mon, 24 Apr 2023 22:08:22 -0400 Subject: [PATCH 092/244] Add fish to the badShells list --- src/ShellCheck/Parser.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 7a50967..9d7df00 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -3360,6 +3360,7 @@ readScriptFile sourced = do "awk", "csh", "expect", + "fish", "perl", "python", "ruby", From 46b678fca8f8aac035d04e676f77f1a92f6742f4 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 30 Apr 2023 14:37:37 -0700 Subject: [PATCH 093/244] Minor fixes to POSIX read without variable check --- src/ShellCheck/Checks/ShellSupport.hs | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index eda6882..cf8acc9 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -188,6 +188,7 @@ prop_checkBashisms100 = verify checkBashisms "read -r" prop_checkBashisms101 = verify checkBashisms "read" prop_checkBashisms102 = verifyNot checkBashisms "read -r foo" prop_checkBashisms103 = verifyNot checkBashisms "read foo" +prop_checkBashisms104 = verifyNot checkBashisms "read ''" checkBashisms = ForShell [Sh, Dash] $ \t -> do params <- ask kludge params t @@ -288,13 +289,6 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do argString = concat $ oversimplify arg flagRegex = mkRegex "^-[eEsn]+$" - bashism t@(T_SimpleCommand _ _ (cmd:args)) - | t `isCommand` "read" && length (onlyNames args) == 0 = - warnMsg (getId cmd) 3061 "read without a variable is" - where - notFlag arg = head (concat $ oversimplify arg) /= '-' - onlyNames = filter (notFlag) - bashism t@(T_SimpleCommand _ _ (cmd:arg:_)) | getLiteralString cmd == Just "exec" && "-" `isPrefixOf` concat (oversimplify arg) = warnMsg (getId arg) 3038 "exec flags are" @@ -390,6 +384,9 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do let literal = onlyLiteralString format guard $ "%q" `isInfixOf` literal return $ warnMsg (getId format) 3050 "printf %q is" + + when (name == "read" && all isFlag rest) $ + warnMsg (getId cmd) 3061 "read without a variable is" where unsupportedCommands = [ "let", "caller", "builtin", "complete", "compgen", "declare", "dirs", "disown", From b3932dfa10804434fb8c15dc32e428c5a1c3bfa4 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 1 May 2023 00:02:53 -0400 Subject: [PATCH 094/244] Fix #2734: adjust bounds to compile on 9.6 The whole test suite passes for me, including prop_checkOverwrittenExitCode8, and I get the same set of findings with this build and shellcheck.net on tools/testing/selftests/net/icmp_redirect.sh. --- ShellCheck.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ShellCheck.cabal b/ShellCheck.cabal index 8afebe1..f09521f 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -46,7 +46,7 @@ library semigroups build-depends: -- The lower bounds are based on GHC 7.10.3 - -- The upper bounds are based on GHC 9.4.3 + -- The upper bounds are based on GHC 9.6.1 aeson >= 1.4.0 && < 2.2, array >= 0.5.1 && < 0.6, base >= 4.8.0.0 && < 5, @@ -54,13 +54,13 @@ library containers >= 0.5.6 && < 0.7, deepseq >= 1.4.1 && < 1.5, Diff >= 0.4.0 && < 0.5, - fgl >= 5.7.0 && < 5.8.1.0, + fgl (>= 5.7.0 && < 5.8.1.0) || (>= 5.8.1.1 && < 5.9), filepath >= 1.4.0 && < 1.5, - mtl >= 2.2.2 && < 2.3, + mtl >= 2.2.2 && < 2.4, parsec >= 3.1.14 && < 3.2, QuickCheck >= 2.14.2 && < 2.15, regex-tdfa >= 1.2.0 && < 1.4, - transformers >= 0.4.2 && < 0.6, + transformers >= 0.4.2 && < 0.7, -- getXdgDirectory from 1.2.3.0 directory >= 1.2.3 && < 1.4, From f03c437e2fe0d669d1e64dcedd305d5bd8ca0608 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Wed, 24 May 2023 16:38:53 -0400 Subject: [PATCH 095/244] Get rid of a dangerous partial function from checkSpacefulnessCfg' --- src/ShellCheck/Analytics.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 1f6d96d..ecc170d 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2134,7 +2134,8 @@ checkSpacefulnessCfg' dirtyPass params token@(T_DollarBraced id _ list) = addDoubleQuotesAround params token where - name = getBracedReference $ concat $ oversimplify list + bracedString = concat $ oversimplify list + name = getBracedReference bracedString parents = parentMap params needsQuoting = not (isArrayExpansion token) -- There's another warning for this @@ -2153,14 +2154,10 @@ checkSpacefulnessCfg' dirtyPass params token@(T_DollarBraced id _ list) = || CF.spaceStatus (CF.variableValue state) == CF.SpaceStatusClean isDefaultAssignment parents token = - let modifier = getBracedModifier $ bracedString token in + let modifier = getBracedModifier bracedString in any (`isPrefixOf` modifier) ["=", ":="] && isParamTo parents ":" token - -- Given a T_DollarBraced, return a simplified version of the string contents. - bracedString (T_DollarBraced _ _ l) = concat $ oversimplify l - bracedString _ = error $ pleaseReport "bracedString on non-variable" - checkSpacefulnessCfg' _ _ _ = return () From b625cc1accb3249322ca757b6709840f7582b072 Mon Sep 17 00:00:00 2001 From: Nicolas Theodarus Date: Sun, 28 May 2023 12:33:16 +0200 Subject: [PATCH 096/244] add dependabot.yml --- .github/dependabot.yml | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 .github/dependabot.yml diff --git a/.github/dependabot.yml b/.github/dependabot.yml new file mode 100644 index 0000000..81bae9a --- /dev/null +++ b/.github/dependabot.yml @@ -0,0 +1,7 @@ +version: 2 + +updates: + - package-ecosystem: "github-actions" + directory: "/" + schedule: + interval: "daily" From 01aee1a859913a02b529d1f25469693166d3fe7c Mon Sep 17 00:00:00 2001 From: Danny Faught Date: Fri, 28 Jul 2023 14:19:54 -0400 Subject: [PATCH 097/244] improve short description * The short description used to say that until commit aac7d76047a5b28d064b17a5d0fac022054d05a0 from 2014. It appears that it was changed by mistake in that commit to something less readable. * With the message "use -print0/-0" we were confused and introduced a bug in our code because we didn't understand what to do with the "-0". * SC2011 (source https://github.com/koalaman/shellcheck/blob/c9e27c24700cdc5b84cfca1f7a90fe07f542867c/src/ShellCheck/Analytics.hs#L591) uses that exact warning message, we copied it from there. Signed-off-by: Bruce Ricard --- src/ShellCheck/Analytics.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index ecc170d..3bb1ed0 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -562,7 +562,7 @@ checkPipePitfalls _ (T_Pipeline id _ commands) = do hasParameter "print0", hasParameter "printf" ]) $ warn (getId find) 2038 - "Use -print0/-0 or -exec + to allow for non-alphanumeric filenames." + "Use 'find .. -print0 | xargs -0 ..' or 'find .. -exec .. +' to allow non-alphanumeric filenames." for ["ps", "grep"] $ \(ps:grep:_) -> From 372c0b667e7b6f36a5f1a42a9802eb0246ee3e95 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 30 Jul 2023 13:47:00 -0700 Subject: [PATCH 098/244] SC2324: Warn when x+=1 appends. --- CHANGELOG.md | 1 + src/ShellCheck/ASTLib.hs | 9 +++++++++ src/ShellCheck/Analytics.hs | 38 +++++++++++++++++++++++++++++++++++ src/ShellCheck/CFGAnalysis.hs | 16 +++++++++++++++ 4 files changed, 64 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index fc1c0ce..8f4426e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,6 @@ ## Git ### Added +- SC2324: Warn when x+=1 appends instead of increments. ### Fixed diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 56903ee..64fa762 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -886,6 +886,15 @@ isUnmodifiedParameterExpansion t = in getBracedReference str == str _ -> False +-- Return the referenced variable if (and only if) it's an unmodified parameter expansion. +getUnmodifiedParameterExpansion t = + case t of + T_DollarBraced _ _ list -> do + let str = concat $ oversimplify list + guard $ getBracedReference str == str + return str + _ -> Nothing + --- A list of the element and all its parents up to the root node. getPath tree t = t : case Map.lookup (getId t) tree of diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index ecc170d..dbad0f5 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -201,6 +201,7 @@ nodeChecks = [ ,checkOverwrittenExitCode ,checkUnnecessaryArithmeticExpansionIndex ,checkUnnecessaryParens + ,checkPlusEqualsNumber ] optionalChecks = map fst optionalTreeChecks @@ -5007,5 +5008,42 @@ checkUnnecessaryParens params t = ] +prop_checkPlusEqualsNumber1 = verify checkPlusEqualsNumber "x+=1" +prop_checkPlusEqualsNumber2 = verify checkPlusEqualsNumber "x+=42" +prop_checkPlusEqualsNumber3 = verifyNot checkPlusEqualsNumber "(( x += 1 ))" +prop_checkPlusEqualsNumber4 = verifyNot checkPlusEqualsNumber "declare -i x=0; x+=1" +prop_checkPlusEqualsNumber5 = verifyNot checkPlusEqualsNumber "x+='1'" +prop_checkPlusEqualsNumber6 = verifyNot checkPlusEqualsNumber "n=foo; x+=n" +prop_checkPlusEqualsNumber7 = verify checkPlusEqualsNumber "n=4; x+=n" +prop_checkPlusEqualsNumber8 = verify checkPlusEqualsNumber "n=4; x+=$n" +prop_checkPlusEqualsNumber9 = verifyNot checkPlusEqualsNumber "declare -ia var; var[x]+=1" +checkPlusEqualsNumber params t = + case t of + T_Assignment id Append var _ word -> sequence_ $ do + state <- CF.getIncomingState (cfgAnalysis params) id + guard $ isNumber state word + guard . not $ fromMaybe False $ CF.variableMayBeDeclaredInteger state var + return $ warn id 2324 "var+=1 will append, not increment. Use (( var += 1 )), declare -i var, or quote number to silence." + _ -> return () + + where + isNumber state word = + let + unquotedLiteral = getUnquotedLiteral word + isEmpty = unquotedLiteral == Just "" + isUnquotedNumber = not isEmpty && fromMaybe False (all isDigit <$> unquotedLiteral) + isNumericalVariableName = fromMaybe False $ do + str <- unquotedLiteral + CF.variableMayBeAssignedInteger state str + isNumericalVariableExpansion = + case word of + T_NormalWord _ [part] -> fromMaybe False $ do + str <- getUnmodifiedParameterExpansion part + CF.variableMayBeAssignedInteger state str + _ -> False + in + isUnquotedNumber || isNumericalVariableName || isNumericalVariableExpansion + + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 4e36cf5..3b4f957 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -59,6 +59,8 @@ module ShellCheck.CFGAnalysis ( ,getIncomingState ,getOutgoingState ,doesPostDominate + ,variableMayBeDeclaredInteger + ,variableMayBeAssignedInteger ,ShellCheck.CFGAnalysis.runTests -- STRIP ) where @@ -153,6 +155,20 @@ doesPostDominate analysis target base = fromMaybe False $ do (targetStart, _) <- M.lookup target $ tokenToRange analysis return $ targetStart `elem` (postDominators analysis ! baseEnd) +-- See if any execution path results in the variable containing a state +variableMayHaveState :: ProgramState -> String -> CFVariableProp -> Maybe Bool +variableMayHaveState state var property = do + value <- M.lookup var $ variablesInScope state + return $ any (S.member property) $ variableProperties value + +-- See if any execution path declares the variable an integer (declare -i). +variableMayBeDeclaredInteger state var = variableMayHaveState state var CFVPInteger + +-- See if any execution path suggests the variable may contain an integer value +variableMayBeAssignedInteger state var = do + value <- M.lookup var $ variablesInScope state + return $ (numericalStatus $ variableValue value) >= NumericalStatusMaybe + getDataForNode analysis node = M.lookup node $ nodeToData analysis -- The current state of data flow at a point in the program, potentially as a diff From 9490b9488627a06e0a4af1c11644b7936b8a2422 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 30 Jul 2023 16:52:40 -0700 Subject: [PATCH 099/244] Save and restore pending here docs when sourcing files (fixes #2803) --- CHANGELOG.md | 3 ++- src/ShellCheck/Checker.hs | 9 +++++++++ src/ShellCheck/Parser.hs | 10 ++++++++-- 3 files changed, 19 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8f4426e..c6c9513 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,9 @@ ## Git ### Added -- SC2324: Warn when x+=1 appends instead of increments. +- SC2324: Warn when x+=1 appends instead of increments ### Fixed +- source statements with here docs now work correctly ### Changed diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index b56be68..c79f90f 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -508,5 +508,14 @@ prop_rcCanSuppressEarlyProblems2 = null result csScript = "!/bin/bash\necho 'hello world'" } +prop_sourceWithHereDocWorks = null result + where + result = checkWithIncludes [("bar", "true\n")] "source bar << eof\nlol\neof" + +prop_hereDocsAreParsedWithoutTrailingLinefeed = 1044 `elem` result + where + result = check "cat << eof" + + return [] runTests = $quickCheckAll diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 9d7df00..341a435 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -2283,8 +2283,13 @@ readSource t@(T_Redirecting _ _ (T_SimpleCommand cmdId _ (cmd:file':rest'))) = d subRead name script = withContext (ContextSource name) $ - inSeparateContext $ - subParse (initialPos name) (readScriptFile True) script + inSeparateContext $ do + oldState <- getState + setState $ oldState { pendingHereDocs = [] } + result <- subParse (initialPos name) (readScriptFile True) script + newState <- getState + setState $ newState { pendingHereDocs = pendingHereDocs oldState } + return result readSource t = return t @@ -3322,6 +3327,7 @@ readScriptFile sourced = do then do commands <- readCompoundListOrEmpty id <- endSpan start + readPendingHereDocs verifyEof let script = T_Annotation annotationId annotations $ T_Script id shebang commands From dd747b2a98c3214978a97b9ee0ec38e635b6e621 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 30 Jul 2023 19:18:27 -0700 Subject: [PATCH 100/244] SC2325/SC2326: Warn about ! ! foo and foo | ! bar (fixes #2810) --- CHANGELOG.md | 2 ++ src/ShellCheck/Checks/ShellSupport.hs | 26 ++++++++++++++++++++++++++ src/ShellCheck/Parser.hs | 22 +++++++++++++++------- 3 files changed, 43 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c6c9513..0338f7d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,8 @@ ## Git ### Added - SC2324: Warn when x+=1 appends instead of increments +- SC2325: Warn about multiple `!`s in dash/sh. +- SC2326: Warn about `foo | ! bar` in bash/dash/sh. ### Fixed - source statements with here docs now work correctly diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index cf8acc9..c7ece1a 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -60,6 +60,8 @@ checks = [ ,checkBraceExpansionVars ,checkMultiDimensionalArrays ,checkPS1Assignments + ,checkMultipleBangs + ,checkBangAfterPipe ] testChecker (ForShell _ t) = @@ -566,5 +568,29 @@ checkPS1Assignments = ForShell [Bash] f escapeRegex = mkRegex "\\\\x1[Bb]|\\\\e|\x1B|\\\\033" +prop_checkMultipleBangs1 = verify checkMultipleBangs "! ! true" +prop_checkMultipleBangs2 = verifyNot checkMultipleBangs "! true" +checkMultipleBangs = ForShell [Dash, Sh] f + where + f token = case token of + T_Banged id (T_Banged _ _) -> + err id 2325 "Multiple ! in front of pipelines are a bash/ksh extension. Use only 0 or 1." + _ -> return () + + +prop_checkBangAfterPipe1 = verify checkBangAfterPipe "true | ! true" +prop_checkBangAfterPipe2 = verifyNot checkBangAfterPipe "true | ( ! true )" +prop_checkBangAfterPipe3 = verifyNot checkBangAfterPipe "! ! true | true" +checkBangAfterPipe = ForShell [Dash, Sh, Bash] f + where + f token = case token of + T_Pipeline _ _ cmds -> mapM_ check cmds + _ -> return () + + check token = case token of + T_Banged id _ -> + err id 2326 "! is not allowed in the middle of pipelines. Use command group as in cmd | { ! cmd; } if necessary." + _ -> return () + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 341a435..ffc58e2 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -2296,14 +2296,18 @@ readSource t = return t prop_readPipeline = isOk readPipeline "! cat /etc/issue | grep -i ubuntu" prop_readPipeline2 = isWarning readPipeline "!cat /etc/issue | grep -i ubuntu" prop_readPipeline3 = isOk readPipeline "for f; do :; done|cat" +prop_readPipeline4 = isOk readPipeline "! ! true" +prop_readPipeline5 = isOk readPipeline "true | ! true" readPipeline = do unexpecting "keyword/token" readKeyword - do - (T_Bang id) <- g_Bang - pipe <- readPipeSequence - return $ T_Banged id pipe - <|> - readPipeSequence + readBanged readPipeSequence + +readBanged parser = do + pos <- getPosition + (T_Bang id) <- g_Bang + next <- readBanged parser + return $ T_Banged id next + <|> parser prop_readAndOr = isOk readAndOr "grep -i lol foo || exit 1" prop_readAndOr1 = isOk readAndOr "# shellcheck disable=1\nfoo" @@ -2359,7 +2363,7 @@ readTerm = do readPipeSequence = do start <- startSpan - (cmds, pipes) <- sepBy1WithSeparators readCommand + (cmds, pipes) <- sepBy1WithSeparators (readBanged readCommand) (readPipe `thenSkip` (spacing >> readLineBreak)) id <- endSpan start spacing @@ -2389,6 +2393,10 @@ readCommand = choice [ ] readCmdName = do + -- If the command name is `!` then + optional . lookAhead . try $ do + char '!' + whitespace -- Ignore alias suppression optional . try $ do char '\\' From 90d3172dfec30a7569f95b32479ae97af73b8b2e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 13 Aug 2023 16:32:53 -0700 Subject: [PATCH 101/244] Add a newSystemInterface to go with the rest of the new* constructors --- shellcheck.hs | 2 +- src/ShellCheck/Interface.hs | 15 ++++++++++++--- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/shellcheck.hs b/shellcheck.hs index 4e8a155..6be9bb1 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -396,7 +396,7 @@ ioInterface options files = do inputs <- mapM normalize files cache <- newIORef emptyCache configCache <- newIORef ("", Nothing) - return SystemInterface { + return (newSystemInterface :: SystemInterface IO) { siReadFile = get cache inputs, siFindSource = findSourceFile inputs (sourcePaths options), siGetConfig = getConfig configCache diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index 7528559..077212f 100644 --- a/src/ShellCheck/Interface.hs +++ b/src/ShellCheck/Interface.hs @@ -39,11 +39,12 @@ module ShellCheck.Interface , ColorOption(ColorAuto, ColorAlways, ColorNever) , TokenComment(tcId, tcComment, tcFix) , emptyCheckResult - , newParseResult - , newAnalysisSpec , newAnalysisResult + , newAnalysisSpec , newFormatterOptions + , newParseResult , newPosition + , newSystemInterface , newTokenComment , mockedSystemInterface , mockRcFile @@ -135,6 +136,14 @@ newParseSpec = ParseSpec { psShellTypeOverride = Nothing } +newSystemInterface :: Monad m => SystemInterface m +newSystemInterface = + SystemInterface { + siReadFile = \_ _ -> return $ Left "Not implemented", + siFindSource = \_ _ _ name -> return name, + siGetConfig = \_ -> return Nothing + } + -- Parser input and output data ParseSpec = ParseSpec { psFilename :: String, @@ -311,7 +320,7 @@ data ColorOption = -- For testing mockedSystemInterface :: [(String, String)] -> SystemInterface Identity -mockedSystemInterface files = SystemInterface { +mockedSystemInterface files = (newSystemInterface :: SystemInterface Identity) { siReadFile = rf, siFindSource = fs, siGetConfig = const $ return Nothing From 410ec54617c86586cd6b5662ecc035898bd8aefa Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Tue, 5 Sep 2023 08:21:55 +0000 Subject: [PATCH 102/244] Bump actions/checkout from 3 to 4 Bumps [actions/checkout](https://github.com/actions/checkout) from 3 to 4. - [Release notes](https://github.com/actions/checkout/releases) - [Changelog](https://github.com/actions/checkout/blob/main/CHANGELOG.md) - [Commits](https://github.com/actions/checkout/compare/v3...v4) --- updated-dependencies: - dependency-name: actions/checkout dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] --- .github/workflows/build.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index a435cf4..2ca94f2 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -15,7 +15,7 @@ jobs: sudo apt-get install cabal-install - name: Checkout repository - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 @@ -51,7 +51,7 @@ jobs: runs-on: ubuntu-latest steps: - name: Checkout repository - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Download artifacts uses: actions/download-artifact@v3 @@ -74,7 +74,7 @@ jobs: runs-on: ubuntu-latest steps: - name: Checkout repository - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Download artifacts uses: actions/download-artifact@v3 @@ -104,7 +104,7 @@ jobs: environment: Deploy steps: - name: Checkout repository - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Download artifacts uses: actions/download-artifact@v3 From c89ec2fd492d37722f2c93aaae500cc91a84e1c4 Mon Sep 17 00:00:00 2001 From: Max Ulidtko Date: Sun, 1 Oct 2023 19:57:19 +0200 Subject: [PATCH 103/244] Fix: do []-related bashism checks on test(1) calls too --- src/ShellCheck/Checks/ShellSupport.hs | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index c7ece1a..1f012d2 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -19,6 +19,7 @@ -} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ViewPatterns #-} module ShellCheck.Checks.ShellSupport (checker , ShellCheck.Checks.ShellSupport.runTests) where import ShellCheck.AST @@ -91,6 +92,9 @@ prop_checkBashisms3 = verify checkBashisms "echo $((i++))" prop_checkBashisms4 = verify checkBashisms "rm !(*.hs)" prop_checkBashisms5 = verify checkBashisms "source file" prop_checkBashisms6 = verify checkBashisms "[ \"$a\" == 42 ]" +prop_checkBashisms6b = verify checkBashisms "test \"$a\" == 42" +prop_checkBashisms6c = verify checkBashisms "[ foo =~ bar ]" +prop_checkBashisms6d = verify checkBashisms "test foo =~ bar" prop_checkBashisms7 = verify checkBashisms "echo ${var[1]}" prop_checkBashisms8 = verify checkBashisms "echo ${!var[@]}" prop_checkBashisms9 = verify checkBashisms "echo ${!var*}" @@ -106,6 +110,7 @@ prop_checkBashisms18 = verify checkBashisms "foo &> /dev/null" prop_checkBashisms19 = verify checkBashisms "foo > file*.txt" prop_checkBashisms20 = verify checkBashisms "read -ra foo" prop_checkBashisms21 = verify checkBashisms "[ -a foo ]" +prop_checkBashisms21b = verify checkBashisms "test -a foo" prop_checkBashisms22 = verifyNot checkBashisms "[ foo -a bar ]" prop_checkBashisms23 = verify checkBashisms "trap mything ERR INT" prop_checkBashisms24 = verifyNot checkBashisms "trap mything INT TERM" @@ -203,6 +208,7 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do if isDash then err id code $ "In dash, " ++ s ++ " not supported." else warn id code $ "In POSIX sh, " ++ s ++ " undefined." + asStr = getLiteralString bashism (T_ProcSub id _ _) = warnMsg id 3001 "process substitution is" bashism (T_Extglob id _ _) = warnMsg id 3002 "extglob is" @@ -218,17 +224,31 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do bashism (TC_Binary id SingleBracket op _ _) | op `elem` [ "<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="] = unless isDash $ warnMsg id 3012 $ "lexicographical " ++ op ++ " is" + bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just op, rhs]) + | op `elem` [ "<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="] = + unless isDash $ warnMsg id 3012 $ "lexicographical " ++ op ++ " is" bashism (TC_Binary id SingleBracket op _ _) | op `elem` [ "-ot", "-nt", "-ef" ] = unless isDash $ warnMsg id 3013 $ op ++ " is" + bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just op, rhs]) + | op `elem` [ "-ot", "-nt", "-ef" ] = + unless isDash $ warnMsg id 3013 $ op ++ " is" bashism (TC_Binary id SingleBracket "==" _ _) = warnMsg id 3014 "== in place of = is" + bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just "==", rhs]) = + warnMsg id 3014 "== in place of = is" bashism (TC_Binary id SingleBracket "=~" _ _) = warnMsg id 3015 "=~ regex matching is" + bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just "=~", rhs]) = + warnMsg id 3015 "=~ regex matching is" bashism (TC_Unary id SingleBracket "-v" _) = warnMsg id 3016 "unary -v (in place of [ -n \"${var+x}\" ]) is" + bashism (T_SimpleCommand id _ [asStr -> Just "test", asStr -> Just "-v", _]) = + warnMsg id 3016 "unary -v (in place of [ -n \"${var+x}\" ]) is" bashism (TC_Unary id _ "-a" _) = warnMsg id 3017 "unary -a in place of -e is" + bashism (T_SimpleCommand id _ [asStr -> Just "test", asStr -> Just "-a", _]) = + warnMsg id 3017 "unary -a in place of -e is" bashism (TA_Unary id op _) | op `elem` [ "|++", "|--", "++|", "--|"] = warnMsg id 3018 $ filter (/= '|') op ++ " is" From 9605396bef40abdb830bc4c607c3736c007e3482 Mon Sep 17 00:00:00 2001 From: Max Ulidtko Date: Sun, 1 Oct 2023 21:23:25 +0200 Subject: [PATCH 104/244] Docs: describe fixes of PR #2837 in changelog --- CHANGELOG.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0338f7d..b9ce1fb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,12 @@ - SC2324: Warn when x+=1 appends instead of increments - SC2325: Warn about multiple `!`s in dash/sh. - SC2326: Warn about `foo | ! bar` in bash/dash/sh. +- SC3012: Warn about lexicographic-compare bashism in test like in [ ] +- SC3013: Warn bashism `test _ -op/-nt/-ef _` like in [ ] +- SC3014: Warn bashism `test _ == _` like in [ ] +- SC3015: Warn bashism `test _ =~ _` like in [ ] +- SC3016: Warn bashism `test -v _` like in [ ] +- SC3017: Warn bashism `test -a _` like in [ ] ### Fixed - source statements with here docs now work correctly From 6a6d8e9fc488b3b20ab93da2915cccb42e208ddc Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 8 Oct 2023 18:52:05 -0700 Subject: [PATCH 105/244] Revert "Bump actions/checkout from 3 to 4" This reverts commit 410ec54617c86586cd6b5662ecc035898bd8aefa. --- .github/workflows/build.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 2ca94f2..a435cf4 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -15,7 +15,7 @@ jobs: sudo apt-get install cabal-install - name: Checkout repository - uses: actions/checkout@v4 + uses: actions/checkout@v3 with: fetch-depth: 0 @@ -51,7 +51,7 @@ jobs: runs-on: ubuntu-latest steps: - name: Checkout repository - uses: actions/checkout@v4 + uses: actions/checkout@v3 - name: Download artifacts uses: actions/download-artifact@v3 @@ -74,7 +74,7 @@ jobs: runs-on: ubuntu-latest steps: - name: Checkout repository - uses: actions/checkout@v4 + uses: actions/checkout@v3 - name: Download artifacts uses: actions/download-artifact@v3 @@ -104,7 +104,7 @@ jobs: environment: Deploy steps: - name: Checkout repository - uses: actions/checkout@v4 + uses: actions/checkout@v3 - name: Download artifacts uses: actions/download-artifact@v3 From 99a94421ab77397ae98e192a722ba7e61c103dec Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 8 Oct 2023 19:42:31 -0700 Subject: [PATCH 106/244] Manually install 'hub' dependency --- .github/workflows/build.yml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index a435cf4..3e6fb27 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -103,6 +103,11 @@ jobs: runs-on: ubuntu-latest environment: Deploy steps: + - name: Install Dependencies + run: | + sudo apt-get update + sudo apt-get install hub + - name: Checkout repository uses: actions/checkout@v3 From dc2f388310c48eefe4613edf71a703f07d02ffa7 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sat, 14 Oct 2023 18:12:51 -0400 Subject: [PATCH 107/244] Adjust bounds to compile on 9.8 You'll need --allow-newer=fgl:deepseq for it to work too, until haskell/fgl#111 gets merged. --- ShellCheck.cabal | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ShellCheck.cabal b/ShellCheck.cabal index f09521f..76516db 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -46,13 +46,13 @@ library semigroups build-depends: -- The lower bounds are based on GHC 7.10.3 - -- The upper bounds are based on GHC 9.6.1 - aeson >= 1.4.0 && < 2.2, + -- The upper bounds are based on GHC 9.8.1 + aeson >= 1.4.0 && < 2.3, array >= 0.5.1 && < 0.6, base >= 4.8.0.0 && < 5, - bytestring >= 0.10.6 && < 0.12, - containers >= 0.5.6 && < 0.7, - deepseq >= 1.4.1 && < 1.5, + bytestring >= 0.10.6 && < 0.13, + containers >= 0.5.6 && < 0.8, + deepseq >= 1.4.1 && < 1.6, Diff >= 0.4.0 && < 0.5, fgl (>= 5.7.0 && < 5.8.1.0) || (>= 5.8.1.1 && < 5.9), filepath >= 1.4.0 && < 1.5, From 8b3c37aa36bcb74b09d71eba4ce0ce0141b8bd4f Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 16 Oct 2023 00:06:53 -0400 Subject: [PATCH 108/244] Use find instead of listToMaybe and filter --- src/ShellCheck/Analytics.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 7e8b510..3cebb24 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -3320,7 +3320,7 @@ checkReturnAgainstZero params token = isFirstCommandInFunction = fromMaybe False $ do let path = getPath (parentMap params) token - func <- listToMaybe $ filter isFunction path + func <- find isFunction path cmd <- getClosestCommand (parentMap params) token return $ getId cmd == getId (getFirstCommandInFunction func) From 4fd0615501b6909c8ca61ef080bb07b8e8de1301 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 16 Oct 2023 00:55:04 -0400 Subject: [PATCH 109/244] Stop using head in isLeadingNumberVar --- src/ShellCheck/Analytics.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 3cebb24..5f77f77 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4378,9 +4378,8 @@ checkEqualsInCommand params originalToken = return $ isVariableName str isLeadingNumberVar s = - let lead = takeWhile (/= '=') s - in not (null lead) && isDigit (head lead) - && all isVariableChar lead && not (all isDigit lead) + case takeWhile (/= '=') s of + lead@(x:_) -> isDigit x && all isVariableChar lead && not (all isDigit lead) msg cmd leading (T_Literal litId s) = do -- There are many different cases, and the order of the branches matter. From 2a95bc6be3c9fe411e1ddb96e78b467ef2347bdb Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 16 Oct 2023 20:00:31 -0400 Subject: [PATCH 110/244] Switch to getLiteralStringDef to avoid an unnecessary fromJust --- src/ShellCheck/CFG.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index f882adc..2fe11e7 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -1058,7 +1058,7 @@ handleCommand cmd vars args literalCmd = do let id = getId t pre = [t] - literal = fromJust $ getLiteralStringExt (const $ Just "\0") t + literal = getLiteralStringDef "\0" t isKnown = '\0' `notElem` literal match = fmap head $ variableAssignRegex `matchRegex` literal name = fromMaybe literal match From 1aeab287e62ab562142fdb8a42e3f486f93216dd Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Fri, 3 Nov 2023 01:33:49 -0400 Subject: [PATCH 111/244] Add nil case that went missing in 4fd0615 --- src/ShellCheck/Analytics.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 5f77f77..dadf512 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4380,6 +4380,7 @@ checkEqualsInCommand params originalToken = isLeadingNumberVar s = case takeWhile (/= '=') s of lead@(x:_) -> isDigit x && all isVariableChar lead && not (all isDigit lead) + [] -> False msg cmd leading (T_Literal litId s) = do -- There are many different cases, and the order of the branches matter. From be8e4b2b8aac4177ef31092397f1ea2cad8e66ad Mon Sep 17 00:00:00 2001 From: Grische Date: Sat, 25 Nov 2023 12:44:46 +0100 Subject: [PATCH 112/244] add basic busybox sh support --- CHANGELOG.md | 1 + src/ShellCheck/ASTLib.hs | 7 ++++--- src/ShellCheck/Analytics.hs | 4 ++-- src/ShellCheck/AnalyzerLib.hs | 4 ++-- src/ShellCheck/Data.hs | 2 ++ src/ShellCheck/Interface.hs | 5 ++--- src/ShellCheck/Parser.hs | 5 +++-- 7 files changed, 16 insertions(+), 12 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b9ce1fb..897aa27 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ - SC3015: Warn bashism `test _ =~ _` like in [ ] - SC3016: Warn bashism `test -v _` like in [ ] - SC3017: Warn bashism `test -a _` like in [ ] +- Added support for busybox sh ### Fixed - source statements with here docs now work correctly diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 64fa762..cf55498 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -758,8 +758,8 @@ prop_executableFromShebang6 = executableFromShebang "/usr/bin/env --split-string prop_executableFromShebang7 = executableFromShebang "/usr/bin/env --split-string bash -x" == "bash" prop_executableFromShebang8 = executableFromShebang "/usr/bin/env --split-string foo=bar bash -x" == "bash" prop_executableFromShebang9 = executableFromShebang "/usr/bin/env foo=bar dash" == "dash" -prop_executableFromShebang10 = executableFromShebang "/bin/busybox sh" == "ash" -prop_executableFromShebang11 = executableFromShebang "/bin/busybox ash" == "ash" +prop_executableFromShebang10 = executableFromShebang "/bin/busybox sh" == "busybox sh" +prop_executableFromShebang11 = executableFromShebang "/bin/busybox ash" == "busybox ash" -- Get the shell executable from a string like '/usr/bin/env bash' executableFromShebang :: String -> String @@ -776,7 +776,8 @@ executableFromShebang = shellFor [x] -> basename x (first:second:args) | basename first == "busybox" -> case basename second of - "sh" -> "ash" -- busybox sh is ash + "sh" -> "busybox sh" + "ash" -> "busybox ash" x -> x (first:args) | basename first == "env" -> fromEnvArgs args diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index dadf512..5df2f35 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -646,10 +646,10 @@ prop_checkShebang9 = verifyNotTree checkShebang "# shellcheck shell=sh\ntrue" prop_checkShebang10 = verifyNotTree checkShebang "#!foo\n# shellcheck shell=sh ignore=SC2239\ntrue" prop_checkShebang11 = verifyTree checkShebang "#!/bin/sh/\ntrue" prop_checkShebang12 = verifyTree checkShebang "#!/bin/sh/ -xe\ntrue" -prop_checkShebang13 = verifyTree checkShebang "#!/bin/busybox sh" +prop_checkShebang13 = verifyNotTree checkShebang "#!/bin/busybox sh" prop_checkShebang14 = verifyNotTree checkShebang "#!/bin/busybox sh\n# shellcheck shell=sh\n" prop_checkShebang15 = verifyNotTree checkShebang "#!/bin/busybox sh\n# shellcheck shell=dash\n" -prop_checkShebang16 = verifyTree checkShebang "#!/bin/busybox ash" +prop_checkShebang16 = verifyNotTree checkShebang "#!/bin/busybox ash" prop_checkShebang17 = verifyNotTree checkShebang "#!/bin/busybox ash\n# shellcheck shell=dash\n" prop_checkShebang18 = verifyNotTree checkShebang "#!/bin/busybox ash\n# shellcheck shell=sh\n" checkShebang params (T_Annotation _ list t) = diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index ca928fd..d864e32 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -284,8 +284,8 @@ prop_determineShell7 = determineShellTest "#! /bin/ash" == Dash prop_determineShell8 = determineShellTest' (Just Ksh) "#!/bin/sh" == Sh prop_determineShell9 = determineShellTest "#!/bin/env -S dash -x" == Dash prop_determineShell10 = determineShellTest "#!/bin/env --split-string= dash -x" == Dash -prop_determineShell11 = determineShellTest "#!/bin/busybox sh" == Dash -- busybox sh is a specific shell, not posix sh -prop_determineShell12 = determineShellTest "#!/bin/busybox ash" == Dash +prop_determineShell11 = determineShellTest "#!/bin/busybox sh" == BusyboxSh -- busybox sh is a specific shell, not posix sh +prop_determineShell12 = determineShellTest "#!/bin/busybox ash" == BusyboxSh determineShellTest = determineShellTest' Nothing determineShellTest' fallbackShell = determineShell fallbackShell . fromJust . prRoot . pScript diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 550ff87..6a87123 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -156,6 +156,8 @@ shellForExecutable name = "sh" -> return Sh "bash" -> return Bash "bats" -> return Bash + "busybox sh" -> return BusyboxSh + "busybox ash" -> return BusyboxSh "dash" -> return Dash "ash" -> return Dash -- There's also a warning for this. "ksh" -> return Ksh diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index 077212f..c574cee 100644 --- a/src/ShellCheck/Interface.hs +++ b/src/ShellCheck/Interface.hs @@ -28,7 +28,7 @@ module ShellCheck.Interface , AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asOptionalChecks) , AnalysisResult(arComments) , FormatterOptions(foColorOption, foWikiLinkCount) - , Shell(Ksh, Sh, Bash, Dash) + , Shell(Ksh, Sh, Bash, Dash, BusyboxSh) , ExecutionMode(Executed, Sourced) , ErrorMessage , Code @@ -221,7 +221,7 @@ newCheckDescription = CheckDescription { } -- Supporting data types -data Shell = Ksh | Sh | Bash | Dash deriving (Show, Eq) +data Shell = Ksh | Sh | Bash | Dash | BusyboxSh deriving (Show, Eq) data ExecutionMode = Executed | Sourced deriving (Show, Eq) type ErrorMessage = String @@ -335,4 +335,3 @@ mockedSystemInterface files = (newSystemInterface :: SystemInterface Identity) { mockRcFile rcfile mock = mock { siGetConfig = const . return $ Just (".shellcheckrc", rcfile) } - diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index ffc58e2..abd4d94 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -3349,8 +3349,8 @@ readScriptFile sourced = do verifyShebang pos s = do case isValidShell s of Just True -> return () - Just False -> parseProblemAt pos ErrorC 1071 "ShellCheck only supports sh/bash/dash/ksh scripts. Sorry!" - Nothing -> parseProblemAt pos ErrorC 1008 "This shebang was unrecognized. ShellCheck only supports sh/bash/dash/ksh. Add a 'shell' directive to specify." + Just False -> parseProblemAt pos ErrorC 1071 "ShellCheck only supports sh/bash/dash/ksh/'busybox sh' scripts. Sorry!" + Nothing -> parseProblemAt pos ErrorC 1008 "This shebang was unrecognized. ShellCheck only supports sh/bash/dash/ksh/'busybox sh'. Add a 'shell' directive to specify." isValidShell s = let good = null s || any (`isPrefixOf` s) goodShells @@ -3366,6 +3366,7 @@ readScriptFile sourced = do "sh", "ash", "dash", + "busybox sh", "bash", "bats", "ksh" From 1e1045e73e0c66a947390785e95d924203e837fc Mon Sep 17 00:00:00 2001 From: Grische Date: Sat, 25 Nov 2023 12:52:32 +0100 Subject: [PATCH 113/244] make busybox sh Dash-like --- src/ShellCheck/Analytics.hs | 6 +++++- src/ShellCheck/AnalyzerLib.hs | 4 ++++ src/ShellCheck/Checks/Commands.hs | 4 ++-- src/ShellCheck/Checks/ShellSupport.hs | 12 +++++++----- 4 files changed, 18 insertions(+), 8 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 5df2f35..108682a 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1204,6 +1204,7 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do case shellType params of Sh -> return () -- These are unsupported and will be caught by bashism checks. Dash -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting." + BusyboxSh -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting." _ -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting (or switch to [[ .. ]])." when (op `elem` arithmeticBinaryTestOps) $ do @@ -2782,6 +2783,7 @@ checkFunctionDeclarations params when (hasKeyword && hasParens) $ err id 2111 "ksh does not allow 'function' keyword and '()' at the same time." Dash -> forSh + BusyboxSh -> forSh Sh -> forSh where @@ -4044,7 +4046,8 @@ prop_checkModifiedArithmeticInRedirection3 = verifyNot checkModifiedArithmeticIn prop_checkModifiedArithmeticInRedirection4 = verify checkModifiedArithmeticInRedirection "cat <<< $((i++))" prop_checkModifiedArithmeticInRedirection5 = verify checkModifiedArithmeticInRedirection "cat << foo\n$((i++))\nfoo\n" prop_checkModifiedArithmeticInRedirection6 = verifyNot checkModifiedArithmeticInRedirection "#!/bin/dash\nls > $((i=i+1))" -checkModifiedArithmeticInRedirection params t = unless (shellType params == Dash) $ +prop_checkModifiedArithmeticInRedirection7 = verifyNot checkModifiedArithmeticInRedirection "#!/bin/busybox sh\ncat << foo\n$((i++))\nfoo\n" +checkModifiedArithmeticInRedirection params t = unless (shellType params == Dash || shellType params == BusyboxSh) $ case t of T_Redirecting _ redirs (T_SimpleCommand _ _ (_:_)) -> mapM_ checkRedirs redirs _ -> return () @@ -4356,6 +4359,7 @@ checkEqualsInCommand params originalToken = Bash -> errWithFix id 2277 "Use BASH_ARGV0 to assign to $0 in bash (or use [ ] to compare)." bashfix Ksh -> err id 2278 "$0 can't be assigned in Ksh (but it does reflect the current function)." Dash -> err id 2279 "$0 can't be assigned in Dash. This becomes a command name." + BusyboxSh -> err id 2279 "$0 can't be assigned in Busybox Ash. This becomes a command name." _ -> err id 2280 "$0 can't be assigned this way, and there is no portable alternative." leadingNumberMsg id = err id 2282 "Variable names can't start with numbers, so this is interpreted as a command." diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index d864e32..4990822 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -206,18 +206,21 @@ makeParameters spec = params case shellType params of Bash -> isOptionSet "lastpipe" root Dash -> False + BusyboxSh -> False Sh -> False Ksh -> True, hasInheritErrexit = case shellType params of Bash -> isOptionSet "inherit_errexit" root Dash -> True + BusyboxSh -> True Sh -> True Ksh -> False, hasPipefail = case shellType params of Bash -> isOptionSet "pipefail" root Dash -> True + BusyboxSh -> isOptionSet "pipefail" root Sh -> True Ksh -> isOptionSet "pipefail" root, shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec), @@ -899,6 +902,7 @@ isBashLike params = Bash -> True Ksh -> True Dash -> False + BusyboxSh -> False Sh -> False isTrueAssignmentSource c = diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 691836f..8be60a7 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -930,7 +930,7 @@ prop_checkTimedCommand2 = verify checkTimedCommand "#!/bin/dash\ntime ( foo; bar prop_checkTimedCommand3 = verifyNot checkTimedCommand "#!/bin/sh\ntime sleep 1" checkTimedCommand = CommandCheck (Exactly "time") f where f (T_SimpleCommand _ _ (c:args@(_:_))) = - whenShell [Sh, Dash] $ do + whenShell [Sh, Dash, BusyboxSh] $ do let cmd = last args -- "time" is parsed with a command as argument when (isPiped cmd) $ warn (getId c) 2176 "'time' is undefined for pipelines. time single stage or bash -c instead." @@ -954,7 +954,7 @@ checkTimedCommand = CommandCheck (Exactly "time") f where prop_checkLocalScope1 = verify checkLocalScope "local foo=3" prop_checkLocalScope2 = verifyNot checkLocalScope "f() { local foo=3; }" checkLocalScope = CommandCheck (Exactly "local") $ \t -> - whenShell [Bash, Dash] $ do -- Ksh allows it, Sh doesn't support local + whenShell [Bash, Dash, BusyboxSh] $ do -- Ksh allows it, Sh doesn't support local path <- getPathM t unless (any isFunctionLike path) $ err (getId $ getCommandTokenOrThis t) 2168 "'local' is only valid in functions." diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 1f012d2..7112b92 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -76,7 +76,7 @@ verifyNot c s = producesComments (testChecker c) s == Just False prop_checkForDecimals1 = verify checkForDecimals "((3.14*c))" prop_checkForDecimals2 = verify checkForDecimals "foo[1.2]=bar" prop_checkForDecimals3 = verifyNot checkForDecimals "declare -A foo; foo[1.2]=bar" -checkForDecimals = ForShell [Sh, Dash, Bash] f +checkForDecimals = ForShell [Sh, Dash, BusyboxSh, Bash] f where f t@(TA_Expansion id _) = sequence_ $ do str <- getLiteralString t @@ -196,14 +196,16 @@ prop_checkBashisms101 = verify checkBashisms "read" prop_checkBashisms102 = verifyNot checkBashisms "read -r foo" prop_checkBashisms103 = verifyNot checkBashisms "read foo" prop_checkBashisms104 = verifyNot checkBashisms "read ''" -checkBashisms = ForShell [Sh, Dash] $ \t -> do +prop_checkBashisms105 = verifyNot checkBashisms "#!/bin/busybox sh\nset -o pipefail" +checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t where -- This code was copy-pasted from Analytics where params was a variable kludge params = bashism where - isDash = shellType params == Dash + isBusyboxSh = shellType params == BusyboxSh + isDash = shellType params == Dash || isBusyboxSh warnMsg id code s = if isDash then err id code $ "In dash, " ++ s ++ " not supported." @@ -590,7 +592,7 @@ checkPS1Assignments = ForShell [Bash] f prop_checkMultipleBangs1 = verify checkMultipleBangs "! ! true" prop_checkMultipleBangs2 = verifyNot checkMultipleBangs "! true" -checkMultipleBangs = ForShell [Dash, Sh] f +checkMultipleBangs = ForShell [Dash, BusyboxSh, Sh] f where f token = case token of T_Banged id (T_Banged _ _) -> @@ -601,7 +603,7 @@ checkMultipleBangs = ForShell [Dash, Sh] f prop_checkBangAfterPipe1 = verify checkBangAfterPipe "true | ! true" prop_checkBangAfterPipe2 = verifyNot checkBangAfterPipe "true | ( ! true )" prop_checkBangAfterPipe3 = verifyNot checkBangAfterPipe "! ! true | true" -checkBangAfterPipe = ForShell [Dash, Sh, Bash] f +checkBangAfterPipe = ForShell [Dash, BusyboxSh, Sh, Bash] f where f token = case token of T_Pipeline _ _ cmds -> mapM_ check cmds From 00ffd2db33724c31d8857d278379f8140a3f5fce Mon Sep 17 00:00:00 2001 From: Grische Date: Sat, 25 Nov 2023 13:50:23 +0100 Subject: [PATCH 114/244] silence SC3010 for busybox sh --- src/ShellCheck/Checks/ShellSupport.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 7112b92..9ade1c1 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -197,6 +197,7 @@ prop_checkBashisms102 = verifyNot checkBashisms "read -r foo" prop_checkBashisms103 = verifyNot checkBashisms "read foo" prop_checkBashisms104 = verifyNot checkBashisms "read ''" prop_checkBashisms105 = verifyNot checkBashisms "#!/bin/busybox sh\nset -o pipefail" +prop_checkBashisms106 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[[ \"$x\" = \"$x\" ]]" checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t @@ -221,7 +222,8 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do bashism (T_DollarBracket id _) = warnMsg id 3007 "$[..] in place of $((..)) is" bashism (T_SelectIn id _ _ _) = warnMsg id 3008 "select loops are" bashism (T_BraceExpansion id _) = warnMsg id 3009 "brace expansion is" - bashism (T_Condition id DoubleBracket _) = warnMsg id 3010 "[[ ]] is" + bashism (T_Condition id DoubleBracket _) = + unless isBusyboxSh $ warnMsg id 3010 "[[ ]] is" bashism (T_HereString id _) = warnMsg id 3011 "here-strings are" bashism (TC_Binary id SingleBracket op _ _) | op `elem` [ "<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="] = From 903421fb5dff31993c07b8b25eb0d46c388cfba0 Mon Sep 17 00:00:00 2001 From: Grische Date: Sat, 25 Nov 2023 13:53:13 +0100 Subject: [PATCH 115/244] silence SC3014 for busybox sh --- src/ShellCheck/Checks/ShellSupport.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 9ade1c1..e1a09dd 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -198,6 +198,7 @@ prop_checkBashisms103 = verifyNot checkBashisms "read foo" prop_checkBashisms104 = verifyNot checkBashisms "read ''" prop_checkBashisms105 = verifyNot checkBashisms "#!/bin/busybox sh\nset -o pipefail" prop_checkBashisms106 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[[ \"$x\" = \"$x\" ]]" +prop_checkBashisms107 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[ \"$x\" == \"$x\" ]" checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t @@ -238,9 +239,9 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do | op `elem` [ "-ot", "-nt", "-ef" ] = unless isDash $ warnMsg id 3013 $ op ++ " is" bashism (TC_Binary id SingleBracket "==" _ _) = - warnMsg id 3014 "== in place of = is" + unless isBusyboxSh $ warnMsg id 3014 "== in place of = is" bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just "==", rhs]) = - warnMsg id 3014 "== in place of = is" + unless isBusyboxSh $ warnMsg id 3014 "== in place of = is" bashism (TC_Binary id SingleBracket "=~" _ _) = warnMsg id 3015 "=~ regex matching is" bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just "=~", rhs]) = From ac63dc33c9b9b3576bc6e3f44049a9e6a53dfaea Mon Sep 17 00:00:00 2001 From: Grische Date: Sat, 25 Nov 2023 13:55:07 +0100 Subject: [PATCH 116/244] silence SC3020 for busybox sh --- src/ShellCheck/Checks/ShellSupport.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index e1a09dd..4409751 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -199,6 +199,7 @@ prop_checkBashisms104 = verifyNot checkBashisms "read ''" prop_checkBashisms105 = verifyNot checkBashisms "#!/bin/busybox sh\nset -o pipefail" prop_checkBashisms106 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[[ \"$x\" = \"$x\" ]]" prop_checkBashisms107 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[ \"$x\" == \"$x\" ]" +prop_checkBashisms108 = verifyNot checkBashisms "#!/bin/busybox sh\necho magic &> /dev/null" checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t @@ -258,7 +259,8 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do | op `elem` [ "|++", "|--", "++|", "--|"] = warnMsg id 3018 $ filter (/= '|') op ++ " is" bashism (TA_Binary id "**" _ _) = warnMsg id 3019 "exponentials are" - bashism (T_FdRedirect id "&" (T_IoFile _ (T_Greater _) _)) = warnMsg id 3020 "&> is" + bashism (T_FdRedirect id "&" (T_IoFile _ (T_Greater _) _)) = + unless isBusyboxSh $ warnMsg id 3020 "&> is" bashism (T_FdRedirect id "" (T_IoFile _ (T_GREATAND _) file)) = unless (all isDigit $ onlyLiteralString file) $ warnMsg id 3021 ">& filename (as opposed to >& fd) is" bashism (T_FdRedirect id ('{':_) _) = warnMsg id 3022 "named file descriptors are" From a3b8be82fe2b5d41837463bf81b1a92bb84e3835 Mon Sep 17 00:00:00 2001 From: Grische Date: Sat, 25 Nov 2023 13:58:49 +0100 Subject: [PATCH 117/244] silence SC3048 for busybox sh --- src/ShellCheck/Checks/ShellSupport.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 4409751..6ebdd70 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -200,6 +200,7 @@ prop_checkBashisms105 = verifyNot checkBashisms "#!/bin/busybox sh\nset -o pipef prop_checkBashisms106 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[[ \"$x\" = \"$x\" ]]" prop_checkBashisms107 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[ \"$x\" == \"$x\" ]" prop_checkBashisms108 = verifyNot checkBashisms "#!/bin/busybox sh\necho magic &> /dev/null" +prop_checkBashisms109 = verifyNot checkBashisms "#!/bin/busybox sh\ntrap stop EXIT SIGTERM" checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t @@ -399,7 +400,7 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do return $ do when (upper `elem` ["ERR", "DEBUG", "RETURN"]) $ warnMsg (getId token) 3047 $ "trapping " ++ str ++ " is" - when ("SIG" `isPrefixOf` upper) $ + when (not isBusyboxSh && "SIG" `isPrefixOf` upper) $ warnMsg (getId token) 3048 "prefixing signal names with 'SIG' is" when (not isDash && upper /= str) $ From ca255fe3263e53c7cb21618eac7d5e52e5c0a665 Mon Sep 17 00:00:00 2001 From: Grische Date: Sat, 25 Nov 2023 14:04:11 +0100 Subject: [PATCH 118/244] silence SC3046 and SC3051 for busybox sh --- src/ShellCheck/Checks/ShellSupport.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 6ebdd70..f4c93fc 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -201,6 +201,7 @@ prop_checkBashisms106 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[[ \"$x prop_checkBashisms107 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[ \"$x\" == \"$x\" ]" prop_checkBashisms108 = verifyNot checkBashisms "#!/bin/busybox sh\necho magic &> /dev/null" prop_checkBashisms109 = verifyNot checkBashisms "#!/bin/busybox sh\ntrap stop EXIT SIGTERM" +prop_checkBashisms110 = verifyNot checkBashisms "#!/bin/busybox sh\nsource /dev/null" checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t @@ -391,7 +392,8 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do (\x -> (not . null . snd $ x) && snd x `notElem` allowed) flags return . warnMsg (getId word) 3045 $ name ++ " -" ++ flag ++ " is" - when (name == "source") $ warnMsg id 3046 "'source' in place of '.' is" + when (name == "source" && not isBusyboxSh) $ + warnMsg id 3046 "'source' in place of '.' is" when (name == "trap") $ let check token = sequence_ $ do @@ -440,7 +442,9 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do ("wait", Just []) ] bashism t@(T_SourceCommand id src _) - | getCommandName src == Just "source" = warnMsg id 3051 "'source' in place of '.' is" + | getCommandName src == Just "source" = + unless isBusyboxSh $ + warnMsg id 3051 "'source' in place of '.' is" bashism (TA_Expansion _ (T_Literal id str : _)) | str `matches` radix = warnMsg id 3052 "arithmetic base conversion is" where From fdcce458c189848b76d3779e35581cd012af201d Mon Sep 17 00:00:00 2001 From: Grische Date: Sat, 25 Nov 2023 15:10:44 +0100 Subject: [PATCH 119/244] silence some shell expansions for busybox sh --- src/ShellCheck/Checks/ShellSupport.hs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index f4c93fc..e652cb5 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -202,6 +202,15 @@ prop_checkBashisms107 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[ \"$x\ prop_checkBashisms108 = verifyNot checkBashisms "#!/bin/busybox sh\necho magic &> /dev/null" prop_checkBashisms109 = verifyNot checkBashisms "#!/bin/busybox sh\ntrap stop EXIT SIGTERM" prop_checkBashisms110 = verifyNot checkBashisms "#!/bin/busybox sh\nsource /dev/null" +prop_checkBashisms111 = verify checkBashisms "#!/bin/dash\nx='test'\n${x:0:3}" -- SC3057 +prop_checkBashisms112 = verifyNot checkBashisms "#!/bin/busybox sh\nx='test'\n${x:0:3}" -- SC3057 +prop_checkBashisms113 = verify checkBashisms "#!/bin/dash\nx='test'\n${x/st/xt}" -- SC3060 +prop_checkBashisms114 = verifyNot checkBashisms "#!/bin/busybox sh\nx='test'\n${x/st/xt}" -- SC3060 +prop_checkBashisms115 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${!x}" -- SC3053 +prop_checkBashisms116 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${x[1]}" -- SC3054 +prop_checkBashisms117 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${!x[@]}" -- SC3055 +prop_checkBashisms118 = verify checkBashisms "#!/bin/busybox sh\nxyz=1\n${!x*}" -- SC3056 +prop_checkBashisms119 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${x^^[t]}" -- SC3059 checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t @@ -282,7 +291,8 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do warnMsg id 3028 $ str ++ " is" bashism t@(T_DollarBraced id _ token) = do - mapM_ check expansion + unless isBusyboxSh $ mapM_ check simpleExpansions + mapM_ check advancedExpansions when (isBashVariable var) $ warnMsg id 3028 $ var ++ " is" where @@ -452,14 +462,16 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do bashism _ = return () varChars="_0-9a-zA-Z" - expansion = let re = mkRegex in [ + advancedExpansions = let re = mkRegex in [ (re $ "^![" ++ varChars ++ "]", 3053, "indirect expansion is"), (re $ "^[" ++ varChars ++ "]+\\[.*\\]$", 3054, "array references are"), (re $ "^![" ++ varChars ++ "]+\\[[*@]]$", 3055, "array key expansion is"), (re $ "^![" ++ varChars ++ "]+[*@]$", 3056, "name matching prefixes are"), + (re $ "^[" ++ varChars ++ "*@]+(\\[.*\\])?[,^]", 3059, "case modification is") + ] + simpleExpansions = let re = mkRegex in [ (re $ "^[" ++ varChars ++ "*@]+:[^-=?+]", 3057, "string indexing is"), (re $ "^([*@][%#]|#[@*])", 3058, "string operations on $@/$* are"), - (re $ "^[" ++ varChars ++ "*@]+(\\[.*\\])?[,^]", 3059, "case modification is"), (re $ "^[" ++ varChars ++ "*@]+(\\[.*\\])?/", 3060, "string replacement is") ] bashVars = [ From b6d4952e2e0602c894f6d9f28e7004c205cbcae7 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 6 Dec 2023 18:41:53 +0100 Subject: [PATCH 120/244] Testsuite: report which module failed the tests This also fixes the problem that the testsuite threw `exitFailure` even when it succeeded (which I found inexplicable). Once this is published, the testsuite could be enabled in Stackage again. --- .gitignore | 1 + test/shellcheck.hs | 37 ++++++++++++++++++++----------------- 2 files changed, 21 insertions(+), 17 deletions(-) diff --git a/.gitignore b/.gitignore index 6d5f1ae..cf373a8 100644 --- a/.gitignore +++ b/.gitignore @@ -20,3 +20,4 @@ cabal.config /parts/ /prime/ *.snap +/dist-newstyle/ diff --git a/test/shellcheck.hs b/test/shellcheck.hs index 1a272af..d5e056d 100644 --- a/test/shellcheck.hs +++ b/test/shellcheck.hs @@ -18,21 +18,24 @@ import qualified ShellCheck.Parser main = do putStrLn "Running ShellCheck tests..." - results <- sequence [ - ShellCheck.Analytics.runTests - ,ShellCheck.AnalyzerLib.runTests - ,ShellCheck.ASTLib.runTests - ,ShellCheck.CFG.runTests - ,ShellCheck.CFGAnalysis.runTests - ,ShellCheck.Checker.runTests - ,ShellCheck.Checks.Commands.runTests - ,ShellCheck.Checks.ControlFlow.runTests - ,ShellCheck.Checks.Custom.runTests - ,ShellCheck.Checks.ShellSupport.runTests - ,ShellCheck.Fixer.runTests - ,ShellCheck.Formatter.Diff.runTests - ,ShellCheck.Parser.runTests + failures <- filter (not . snd) <$> mapM sequenceA tests + if null failures then exitSuccess else do + putStrLn "Tests failed for the following module(s):" + mapM (putStrLn . ("- ShellCheck." ++) . fst) failures + exitFailure + where + tests = + [ ("Analytics" , ShellCheck.Analytics.runTests) + , ("AnalyzerLib" , ShellCheck.AnalyzerLib.runTests) + , ("ASTLib" , ShellCheck.ASTLib.runTests) + , ("CFG" , ShellCheck.CFG.runTests) + , ("CFGAnalysis" , ShellCheck.CFGAnalysis.runTests) + , ("Checker" , ShellCheck.Checker.runTests) + , ("Checks.Commands" , ShellCheck.Checks.Commands.runTests) + , ("Checks.ControlFlow" , ShellCheck.Checks.ControlFlow.runTests) + , ("Checks.Custom" , ShellCheck.Checks.Custom.runTests) + , ("Checks.ShellSupport", ShellCheck.Checks.ShellSupport.runTests) + , ("Fixer" , ShellCheck.Fixer.runTests) + , ("Formatter.Diff" , ShellCheck.Formatter.Diff.runTests) + , ("Parser" , ShellCheck.Parser.runTests) ] - if and results - then exitSuccess - else exitFailure From 74282b0a9319bdcc0e3a4a17e2db1969e1c73be2 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 10 Dec 2023 17:05:29 -0800 Subject: [PATCH 121/244] Recognize 'busybox' in --shell and directives. Add to doc texts. --- shellcheck.1.md | 3 ++- shellcheck.hs | 2 +- src/ShellCheck/Checks/ShellSupport.hs | 2 ++ src/ShellCheck/Data.hs | 1 + 4 files changed, 6 insertions(+), 2 deletions(-) diff --git a/shellcheck.1.md b/shellcheck.1.md index 9675e79..89f6d50 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -85,7 +85,8 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts. **-s**\ *shell*,\ **--shell=***shell* -: Specify Bourne shell dialect. Valid values are *sh*, *bash*, *dash* and *ksh*. +: Specify Bourne shell dialect. Valid values are *sh*, *bash*, *dash*, *ksh*, + and *busybox*. The default is to deduce the shell from the file's `shell` directive, shebang, or `.bash/.bats/.dash/.ksh` extension, in that order. *sh* refers to POSIX `sh` (not the system's), and will warn of portability issues. diff --git a/shellcheck.hs b/shellcheck.hs index 6be9bb1..6f12238 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -115,7 +115,7 @@ options = [ "Specify path when looking for sourced files (\"SCRIPTDIR\" for script's dir)", Option "s" ["shell"] (ReqArg (Flag "shell") "SHELLNAME") - "Specify dialect (sh, bash, dash, ksh)", + "Specify dialect (sh, bash, dash, ksh, busybox)", Option "S" ["severity"] (ReqArg (Flag "severity") "SEVERITY") "Minimum severity of errors to consider (error, warning, info, style)", diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index e652cb5..d070497 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -211,6 +211,8 @@ prop_checkBashisms116 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${x[1 prop_checkBashisms117 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${!x[@]}" -- SC3055 prop_checkBashisms118 = verify checkBashisms "#!/bin/busybox sh\nxyz=1\n${!x*}" -- SC3056 prop_checkBashisms119 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${x^^[t]}" -- SC3059 +prop_checkBashisms120 = verify checkBashisms "#!/bin/sh\n[ x == y ]" +prop_checkBashisms121 = verifyNot checkBashisms "#!/bin/sh\n# shellcheck shell=busybox\n[ x == y ]" checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 6a87123..917142e 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -156,6 +156,7 @@ shellForExecutable name = "sh" -> return Sh "bash" -> return Bash "bats" -> return Bash + "busybox" -> return BusyboxSh -- Used for directives and --shell=busybox "busybox sh" -> return BusyboxSh "busybox ash" -> return BusyboxSh "dash" -> return Dash From f2729f73cbffde5ef332ce943bc07021302781ab Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 10 Dec 2023 17:57:33 -0800 Subject: [PATCH 122/244] Abuse STRIP to avoid crashes on unsupported AST nodes --- src/ShellCheck/CFG.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index 2fe11e7..0cd6326 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -887,7 +887,9 @@ build t = do T_Less _ -> none T_ParamSubSpecialChar _ _ -> none - x -> error ("Unimplemented: " ++ show x) + x -> do + error ("Unimplemented: " ++ show x) -- STRIP + none -- Still in `where` clause forInHelper id name words body = do From a9e7bf1950ed50bdfbc818710085c6414f8bf20e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 10 Dec 2023 19:13:34 -0800 Subject: [PATCH 123/244] Reparse indices after attaching here docs (fixes #2846) --- src/ShellCheck/Checker.hs | 3 +++ src/ShellCheck/Parser.hs | 6 +++--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index c79f90f..6c9166f 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -516,6 +516,9 @@ prop_hereDocsAreParsedWithoutTrailingLinefeed = 1044 `elem` result where result = check "cat << eof" +prop_hereDocsWillHaveParsedIndices = null result + where + result = check "#!/bin/bash\nmy_array=(a b)\ncat <> ./test\n $(( 1 + my_array[1] ))\nEOF" return [] runTests = $quickCheckAll diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index abd4d94..701010f 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -3339,7 +3339,8 @@ readScriptFile sourced = do verifyEof let script = T_Annotation annotationId annotations $ T_Script id shebang commands - reparseIndices script + userstate <- getState + reparseIndices $ reattachHereDocs script (hereDocMap userstate) else do many anyChar id <- endSpan start @@ -3487,8 +3488,7 @@ parseShell env name contents = do return newParseResult { prComments = map toPositionedComment $ nub $ parseNotes userstate ++ parseProblems state, prTokenPositions = Map.map startEndPosToPos (positionMap userstate), - prRoot = Just $ - reattachHereDocs script (hereDocMap userstate) + prRoot = Just script } Left err -> do let context = contextStack state From 4c1d9171b26074e52736f3a58635d69a18326d68 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 11 Dec 2023 15:08:39 -0500 Subject: [PATCH 124/244] Remove partial head function from src/ShellCheck/Formatter/TTY.hs --- src/ShellCheck/Formatter/TTY.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/ShellCheck/Formatter/TTY.hs b/src/ShellCheck/Formatter/TTY.hs index e28696c..e503639 100644 --- a/src/ShellCheck/Formatter/TTY.hs +++ b/src/ShellCheck/Formatter/TTY.hs @@ -31,9 +31,9 @@ import Data.Ord import Data.IORef import Data.List import Data.Maybe -import GHC.Exts import System.IO import System.Info +import qualified Data.List.NonEmpty as NE wikiLink = "https://www.shellcheck.net/wiki/" @@ -117,19 +117,19 @@ outputResult options ref result sys = do color <- getColorFunc $ foColorOption options let comments = crComments result appendComments ref comments (fromIntegral $ foWikiLinkCount options) - let fileGroups = groupWith sourceFile comments + let fileGroups = NE.groupWith sourceFile comments mapM_ (outputForFile color sys) fileGroups outputForFile color sys comments = do - let fileName = sourceFile (head comments) + let fileName = sourceFile (NE.head comments) result <- siReadFile sys (Just True) fileName let contents = either (const "") id result let fileLinesList = lines contents let lineCount = length fileLinesList let fileLines = listArray (1, lineCount) fileLinesList - let groups = groupWith lineNo comments + let groups = NE.groupWith lineNo comments forM_ groups $ \commentsForLine -> do - let lineNum = fromIntegral $ lineNo (head commentsForLine) + let lineNum = fromIntegral $ lineNo (NE.head commentsForLine) let line = if lineNum < 1 || lineNum > lineCount then "" else fileLines ! fromIntegral lineNum @@ -139,7 +139,7 @@ outputForFile color sys comments = do putStrLn (color "source" line) forM_ commentsForLine $ \c -> putStrLn $ color (severityText c) $ cuteIndent c putStrLn "" - showFixedString color commentsForLine (fromIntegral lineNum) fileLines + showFixedString color (toList commentsForLine) (fromIntegral lineNum) fileLines -- Pick out only the lines necessary to show a fix in action sliceFile :: Fix -> Array Int String -> (Fix, Array Int String) From e5208ccb50e3d10957c13f0b77d19936fa4842e1 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 11 Dec 2023 15:43:35 -0500 Subject: [PATCH 125/244] Remove partial head function from src/ShellCheck/Formatter/JSON1.hs --- src/ShellCheck/Formatter/JSON1.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/Formatter/JSON1.hs b/src/ShellCheck/Formatter/JSON1.hs index 2169bf6..b4dbe35 100644 --- a/src/ShellCheck/Formatter/JSON1.hs +++ b/src/ShellCheck/Formatter/JSON1.hs @@ -27,9 +27,9 @@ import Control.DeepSeq import Data.Aeson import Data.IORef import Data.Monoid -import GHC.Exts import System.IO import qualified Data.ByteString.Lazy.Char8 as BL +import qualified Data.List.NonEmpty as NE format :: IO Formatter format = do @@ -114,10 +114,10 @@ outputError file msg = hPutStrLn stderr $ file ++ ": " ++ msg collectResult ref cr sys = mapM_ f groups where comments = crComments cr - groups = groupWith sourceFile comments - f :: [PositionedComment] -> IO () + groups = NE.groupWith sourceFile comments + f :: NE.NonEmpty PositionedComment -> IO () f group = do - let filename = sourceFile (head group) + let filename = sourceFile (NE.head group) result <- siReadFile sys (Just True) filename let contents = either (const "") id result let comments' = makeNonVirtual comments contents From 5a961371a75baea7d04ce96bf8b85e548f566e1a Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 11 Dec 2023 15:55:29 -0500 Subject: [PATCH 126/244] Remove partial head function from src/ShellCheck/Formatter/GCC.hs --- src/ShellCheck/Formatter/GCC.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/ShellCheck/Formatter/GCC.hs b/src/ShellCheck/Formatter/GCC.hs index 5106e4c..b921753 100644 --- a/src/ShellCheck/Formatter/GCC.hs +++ b/src/ShellCheck/Formatter/GCC.hs @@ -23,8 +23,8 @@ import ShellCheck.Interface import ShellCheck.Formatter.Format import Data.List -import GHC.Exts import System.IO +import qualified Data.List.NonEmpty as NE format :: IO Formatter format = return Formatter { @@ -39,13 +39,13 @@ outputError file error = hPutStrLn stderr $ file ++ ": " ++ error outputAll cr sys = mapM_ f groups where comments = crComments cr - groups = groupWith sourceFile comments - f :: [PositionedComment] -> IO () + groups = NE.groupWith sourceFile comments + f :: NE.NonEmpty PositionedComment -> IO () f group = do - let filename = sourceFile (head group) + let filename = sourceFile (NE.head group) result <- siReadFile sys (Just True) filename let contents = either (const "") id result - outputResult filename contents group + outputResult filename contents (NE.toList group) outputResult filename contents warnings = do let comments = makeNonVirtual warnings contents From e5028481e24e6e95ee11c6fae2323fca80449700 Mon Sep 17 00:00:00 2001 From: slycordinator <68940237+slycordinator@users.noreply.github.com> Date: Thu, 14 Dec 2023 15:24:49 +0900 Subject: [PATCH 127/244] Add installation directions for winge ShellCheck is now available on winget, so we can add it to the installation methods. --- README.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/README.md b/README.md index 9d98b9d..ca9b847 100644 --- a/README.md +++ b/README.md @@ -194,6 +194,12 @@ On Windows (via [chocolatey](https://chocolatey.org/packages/shellcheck)): C:\> choco install shellcheck ``` +Or Windows (via [winget](https://github.com/microsoft/winget-pkgs)): + +```cmd +C:\> winget install --id koalaman.shellcheck +``` + Or Windows (via [scoop](http://scoop.sh)): ```cmd From 09d04c4c9b7dc0c8b466a6976d901ef1fc5c52e5 Mon Sep 17 00:00:00 2001 From: Jens Petersen Date: Fri, 15 Dec 2023 22:40:48 +0800 Subject: [PATCH 128/244] .cabal: allow Diff-0.5 --- ShellCheck.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ShellCheck.cabal b/ShellCheck.cabal index 76516db..a12f75e 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -53,7 +53,7 @@ library bytestring >= 0.10.6 && < 0.13, containers >= 0.5.6 && < 0.8, deepseq >= 1.4.1 && < 1.6, - Diff >= 0.4.0 && < 0.5, + Diff >= 0.4.0 && < 0.6, fgl (>= 5.7.0 && < 5.8.1.0) || (>= 5.8.1.1 && < 5.9), filepath >= 1.4.0 && < 1.5, mtl >= 2.2.2 && < 2.4, From a37803d2b873329f062788f5bcfd20fca8f45edc Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 18 Dec 2023 23:57:47 -0500 Subject: [PATCH 129/244] Remove partial head function from src/ShellCheck/Formatter/CheckStyle.hs --- src/ShellCheck/Formatter/CheckStyle.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/Formatter/CheckStyle.hs b/src/ShellCheck/Formatter/CheckStyle.hs index 6ad6c9c..3f898c3 100644 --- a/src/ShellCheck/Formatter/CheckStyle.hs +++ b/src/ShellCheck/Formatter/CheckStyle.hs @@ -24,8 +24,8 @@ import ShellCheck.Formatter.Format import Data.Char import Data.List -import GHC.Exts import System.IO +import qualified Data.List.NonEmpty as NE format :: IO Formatter format = return Formatter { @@ -45,12 +45,12 @@ outputResults cr sys = else mapM_ outputGroup fileGroups where comments = crComments cr - fileGroups = groupWith sourceFile comments + fileGroups = NE.groupWith sourceFile comments outputGroup group = do - let filename = sourceFile (head group) + let filename = sourceFile (NE.head group) result <- siReadFile sys (Just True) filename let contents = either (const "") id result - outputFile filename contents group + outputFile filename contents (NE.toList group) outputFile filename contents warnings = do let comments = makeNonVirtual warnings contents From f242922a2e76ad761f23ffba9040293811e7862a Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Tue, 19 Dec 2023 00:00:32 -0500 Subject: [PATCH 130/244] Use onlyLiteralString in more places --- src/ShellCheck/Analytics.hs | 6 +++--- src/ShellCheck/Checks/Commands.hs | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 108682a..b7844dd 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1443,14 +1443,14 @@ prop_checkConstantNullary5 = verify checkConstantNullary "[[ true ]]" prop_checkConstantNullary6 = verify checkConstantNullary "[ 1 ]" prop_checkConstantNullary7 = verify checkConstantNullary "[ false ]" checkConstantNullary _ (TC_Nullary _ _ t) | isConstant t = - case fromMaybe "" $ getLiteralString t of + case onlyLiteralString t of "false" -> err (getId t) 2158 "[ false ] is true. Remove the brackets." "0" -> err (getId t) 2159 "[ 0 ] is true. Use 'false' instead." "true" -> style (getId t) 2160 "Instead of '[ true ]', just use 'true'." "1" -> style (getId t) 2161 "Instead of '[ 1 ]', use 'true'." _ -> err (getId t) 2078 "This expression is constant. Did you forget a $ somewhere?" where - string = fromMaybe "" $ getLiteralString t + string = onlyLiteralString t checkConstantNullary _ _ = return () @@ -2276,7 +2276,7 @@ checkFunctionsUsedExternally params t = (Just str, t) -> do let name = basename str let args = skipOver t argv - let argStrings = map (\x -> (fromMaybe "" $ getLiteralString x, x)) args + let argStrings = map (\x -> (onlyLiteralString x, x)) args let candidates = getPotentialCommands name argStrings mapM_ (checkArg name (getId t)) candidates _ -> return () diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 8be60a7..86fda24 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -186,7 +186,7 @@ checkCommand map t@(T_SimpleCommand id cmdPrefix (cmd:rest)) = sequence_ $ do M.findWithDefault nullCheck (Basename $ basename name) map t else if name == "builtin" && not (null rest) then let t' = T_SimpleCommand id cmdPrefix rest - selectedBuiltin = fromMaybe "" $ getLiteralString . head $ rest + selectedBuiltin = onlyLiteralString $ head rest in M.findWithDefault nullCheck (Exactly selectedBuiltin) map t' else do M.findWithDefault nullCheck (Exactly name) map t @@ -299,7 +299,7 @@ checkExpr = CommandCheck (Basename "expr") f where "'expr' expects 3+ arguments but sees 1. Make sure each operator/operand is a separate argument, and escape <>&|." [first, second] | - (fromMaybe "" $ getLiteralString first) /= "length" + onlyLiteralString first /= "length" && not (willSplit first || willSplit second) -> do checkOp first warn (getId t) 2307 From c97abdb939a52beefa576d984b104eb89e7667d9 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Tue, 19 Dec 2023 00:41:12 -0500 Subject: [PATCH 131/244] Make HereDocPending only hold the relevant pieces of a T_HereDoc instead of an arbitrary Token --- src/ShellCheck/Parser.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 701010f..0e2fc6d 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -160,7 +160,7 @@ data Context = deriving (Show) data HereDocContext = - HereDocPending Token [Context] -- on linefeed, read this T_HereDoc + HereDocPending Id Dashed Quoted String [Context] -- on linefeed, read this T_HereDoc deriving (Show) data UserState = UserState { @@ -238,12 +238,12 @@ addToHereDocMap id list = do hereDocMap = Map.insert id list map } -addPendingHereDoc t = do +addPendingHereDoc id d q str = do state <- getState context <- getCurrentContexts let docs = pendingHereDocs state putState $ state { - pendingHereDocs = HereDocPending t context : docs + pendingHereDocs = HereDocPending id d q str context : docs } popPendingHereDocs = do @@ -1835,7 +1835,7 @@ readHereDoc = called "here document" $ do -- add empty tokens for now, read the rest in readPendingHereDocs let doc = T_HereDoc hid dashed quoted endToken [] - addPendingHereDoc doc + addPendingHereDoc hid dashed quoted endToken return doc where unquote :: String -> (Quoted, String) @@ -1856,7 +1856,7 @@ readPendingHereDocs = do docs <- popPendingHereDocs mapM_ readDoc docs where - readDoc (HereDocPending (T_HereDoc id dashed quoted endToken _) ctx) = + readDoc (HereDocPending id dashed quoted endToken ctx) = swapContext ctx $ do docStartPos <- getPosition From c1452e0d174fe6c4c0a3775d6ee430de1bd8ccda Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Tue, 19 Dec 2023 00:53:08 -0500 Subject: [PATCH 132/244] Remove unnecessary partiality from kludgeAwayQuotes --- src/ShellCheck/Parser.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 0e2fc6d..115de64 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -46,6 +46,7 @@ import Text.Parsec.Error import Text.Parsec.Pos import qualified Control.Monad.Reader as Mr import qualified Control.Monad.State as Ms +import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import Test.QuickCheck.All (quickCheckAll) @@ -2904,8 +2905,8 @@ readLetSuffix = many1 (readIoRedirect <|> try readLetExpression <|> readCmdWord) kludgeAwayQuotes :: String -> SourcePos -> (String, SourcePos) kludgeAwayQuotes s p = case s of - first:rest@(_:_) -> - let (last:backwards) = reverse rest + first:second:rest -> + let (last NE.:| backwards) = NE.reverse (second NE.:| rest) middle = reverse backwards in if first `elem` "'\"" && first == last From 208e38358e8c07688a29867235971136a8ed0092 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Tue, 19 Dec 2023 01:00:20 -0500 Subject: [PATCH 133/244] Use a list comprehension to remove partiality from notesForContext --- src/ShellCheck/Parser.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 115de64..04bdbc4 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -3507,13 +3507,11 @@ parseShell env name contents = do -- A final pass for ignoring parse errors after failed parsing isIgnored stack note = any (contextItemDisablesCode False (codeForParseNote note)) stack -notesForContext list = zipWith ($) [first, second] $ filter isName list +notesForContext list = zipWith ($) [first, second] [(pos, str) | ContextName pos str <- list] where - isName (ContextName _ _) = True - isName _ = False - first (ContextName pos str) = ParseNote pos pos ErrorC 1073 $ + first (pos, str) = ParseNote pos pos ErrorC 1073 $ "Couldn't parse this " ++ str ++ ". Fix to allow more checks." - second (ContextName pos str) = ParseNote pos pos InfoC 1009 $ + second (pos, str) = ParseNote pos pos InfoC 1009 $ "The mentioned syntax error was in this " ++ str ++ "." -- Go over all T_UnparsedIndex and reparse them as either arithmetic or text From 0c46b8b2d5dffcb01b5a4689f16b687bc5a5f84e Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Tue, 19 Dec 2023 01:49:04 -0500 Subject: [PATCH 134/244] Use NonEmpty to remove partiality from handleCommand --- src/ShellCheck/CFG.hs | 41 +++++++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index 0cd6326..5476ad5 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -51,6 +51,7 @@ import Control.Monad.Identity import Data.Array.Unboxed import Data.Array.ST import Data.List hiding (map) +import qualified Data.List.NonEmpty as NE import Data.Maybe import qualified Data.Map as M import qualified Data.Set as S @@ -857,8 +858,8 @@ build t = do status <- newNodeRange (CFSetExitCode id) linkRange assignments status - T_SimpleCommand id vars list@(cmd:_) -> - handleCommand t vars list $ getUnquotedLiteral cmd + T_SimpleCommand id vars (cmd:args) -> + handleCommand t vars (cmd NE.:| args) $ getUnquotedLiteral cmd T_SingleQuoted _ _ -> none @@ -925,8 +926,8 @@ handleCommand cmd vars args literalCmd = do -- TODO: Handle assignments in declaring commands case literalCmd of - Just "exit" -> regularExpansion vars args $ handleExit - Just "return" -> regularExpansion vars args $ handleReturn + Just "exit" -> regularExpansion vars (NE.toList args) $ handleExit + Just "return" -> regularExpansion vars (NE.toList args) $ handleReturn Just "unset" -> regularExpansionWithStatus vars args $ handleUnset args Just "declare" -> handleDeclare args @@ -949,14 +950,14 @@ handleCommand cmd vars args literalCmd = do -- This will mostly behave like 'command' but ok Just "builtin" -> case args of - [_] -> regular - (_:newargs@(newcmd:_)) -> - handleCommand newcmd vars newargs $ getLiteralString newcmd + _ NE.:| [] -> regular + (_ NE.:| newcmd:newargs) -> + handleCommand newcmd vars (newcmd NE.:| newargs) $ getLiteralString newcmd Just "command" -> case args of - [_] -> regular - (_:newargs@(newcmd:_)) -> - handleOthers (getId newcmd) vars newargs $ getLiteralString newcmd + _ NE.:| [] -> regular + (_ NE.:| newcmd:newargs) -> + handleOthers (getId newcmd) vars (newcmd NE.:| newargs) $ getLiteralString newcmd _ -> regular where @@ -984,7 +985,7 @@ handleCommand cmd vars args literalCmd = do unreachable <- newNode CFUnreachable return $ Range ret unreachable - handleUnset (cmd:args) = do + handleUnset (cmd NE.:| args) = do case () of _ | "n" `elem` flagNames -> unsetWith CFUndefineNameref _ | "v" `elem` flagNames -> unsetWith CFUndefineVariable @@ -1003,7 +1004,7 @@ handleCommand cmd vars args literalCmd = do variableAssignRegex = mkRegex "^([_a-zA-Z][_a-zA-Z0-9]*)=" - handleDeclare (cmd:args) = do + handleDeclare (cmd NE.:| args) = do isFunc <- asks cfIsFunction -- This is a bit of a kludge: we don't have great support for things like -- 'declare -i x=$x' so do one round with declare x=$x, followed by declare -i x @@ -1092,7 +1093,7 @@ handleCommand cmd vars args literalCmd = do in concatMap (drop 1) plusses - handlePrintf (cmd:args) = + handlePrintf (cmd NE.:| args) = newNodeRange $ CFApplyEffects $ maybeToList findVar where findVar = do @@ -1101,7 +1102,7 @@ handleCommand cmd vars args literalCmd = do name <- getLiteralString arg return $ IdTagged (getId arg) $ CFWriteVariable name CFValueString - handleWait (cmd:args) = + handleWait (cmd NE.:| args) = newNodeRange $ CFApplyEffects $ maybeToList findVar where findVar = do @@ -1110,7 +1111,7 @@ handleCommand cmd vars args literalCmd = do name <- getLiteralString arg return $ IdTagged (getId arg) $ CFWriteVariable name CFValueInteger - handleMapfile (cmd:args) = + handleMapfile (cmd NE.:| args) = newNodeRange $ CFApplyEffects [findVar] where findVar = @@ -1130,7 +1131,7 @@ handleCommand cmd vars args literalCmd = do guard $ isVariableName name return (getId c, name) - handleRead (cmd:args) = newNodeRange $ CFApplyEffects main + handleRead (cmd NE.:| args) = newNodeRange $ CFApplyEffects main where main = fromMaybe fallback $ do flags <- getGnuOpts flagsForRead args @@ -1160,7 +1161,7 @@ handleCommand cmd vars args literalCmd = do in map (\(id, name) -> IdTagged id $ CFWriteVariable name value) namesOrDefault - handleDEFINE (cmd:args) = + handleDEFINE (cmd NE.:| args) = newNodeRange $ CFApplyEffects $ maybeToList findVar where findVar = do @@ -1170,7 +1171,7 @@ handleCommand cmd vars args literalCmd = do return $ IdTagged (getId name) $ CFWriteVariable str CFValueString handleOthers id vars args cmd = - regularExpansion vars args $ do + regularExpansion vars (NE.toList args) $ do exe <- newNodeRange $ CFExecuteCommand cmd status <- newNodeRange $ CFSetExitCode id linkRange exe status @@ -1189,8 +1190,8 @@ handleCommand cmd vars args literalCmd = do linkRanges $ [args] ++ assignments ++ [exe] ++ dropAssignments - regularExpansionWithStatus vars args@(cmd:_) p = do - initial <- regularExpansion vars args p + regularExpansionWithStatus vars args@(cmd NE.:| _) p = do + initial <- regularExpansion vars (NE.toList args) p status <- newNodeRange $ CFSetExitCode (getId cmd) linkRange initial status From eed0174e90a374ee497aef7d7649e022856e80e9 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Tue, 19 Dec 2023 02:06:45 -0500 Subject: [PATCH 135/244] Make "Unresolved scope in dependency" impossible --- src/ShellCheck/CFG.hs | 24 ++++++++++++------------ src/ShellCheck/CFGAnalysis.hs | 17 ++++++++--------- 2 files changed, 20 insertions(+), 21 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index 5476ad5..ed6a8f8 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -112,8 +112,8 @@ data CFEdge = -- Actions we track data CFEffect = - CFSetProps Scope String (S.Set CFVariableProp) - | CFUnsetProps Scope String (S.Set CFVariableProp) + CFSetProps (Maybe Scope) String (S.Set CFVariableProp) + | CFUnsetProps (Maybe Scope) String (S.Set CFVariableProp) | CFReadVariable String | CFWriteVariable String CFValue | CFWriteGlobal String CFValue @@ -579,7 +579,7 @@ build t = do T_Array _ list -> sequentially list - T_Assignment {} -> buildAssignment DefaultScope t + T_Assignment {} -> buildAssignment Nothing t T_Backgrounded id body -> do start <- newStructuralNode @@ -1031,9 +1031,9 @@ handleCommand cmd vars args literalCmd = do scope isFunc = case () of - _ | global -> GlobalScope - _ | isFunc -> LocalScope - _ -> DefaultScope + _ | global -> Just GlobalScope + _ | isFunc -> Just LocalScope + _ -> Nothing addedProps = S.fromList $ concat $ [ [ CFVPArray | array ], @@ -1178,7 +1178,7 @@ handleCommand cmd vars args literalCmd = do regularExpansion vars args p = do args <- sequentially args - assignments <- mapM (buildAssignment PrefixScope) vars + assignments <- mapM (buildAssignment (Just PrefixScope)) vars exe <- p dropAssignments <- if null vars @@ -1198,7 +1198,7 @@ handleCommand cmd vars args literalCmd = do none = newStructuralNode -data Scope = DefaultScope | GlobalScope | LocalScope | PrefixScope +data Scope = GlobalScope | LocalScope | PrefixScope deriving (Eq, Ord, Show, Generic, NFData) buildAssignment scope t = do @@ -1212,10 +1212,10 @@ buildAssignment scope t = do let valueType = if null indices then f id value else CFValueArray let scoper = case scope of - PrefixScope -> CFWritePrefix - LocalScope -> CFWriteLocal - GlobalScope -> CFWriteGlobal - DefaultScope -> CFWriteVariable + Just PrefixScope -> CFWritePrefix + Just LocalScope -> CFWriteLocal + Just GlobalScope -> CFWriteGlobal + Nothing -> CFWriteVariable write <- newNodeRange $ applySingle $ IdTagged id $ scoper var valueType linkRanges [expand, index, read, write] where diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 3b4f957..16afa68 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -299,7 +299,6 @@ depsToState set = foldl insert newInternalState $ S.toList set PrefixScope -> (sPrefixValues, insertPrefix) LocalScope -> (sLocalValues, insertLocal) GlobalScope -> (sGlobalValues, insertGlobal) - DefaultScope -> error $ pleaseReport "Unresolved scope in dependency" alreadyExists = isJust $ vmLookup name $ mapToCheck state in @@ -1120,34 +1119,34 @@ transferEffect ctx effect = CFSetProps scope name props -> case scope of - DefaultScope -> do + Nothing -> do state <- readVariable ctx name writeVariable ctx name $ addProperties props state - GlobalScope -> do + Just GlobalScope -> do state <- readGlobal ctx name writeGlobal ctx name $ addProperties props state - LocalScope -> do + Just LocalScope -> do out <- readSTRef (cOutput ctx) state <- readLocal ctx name writeLocal ctx name $ addProperties props state - PrefixScope -> do + Just PrefixScope -> do -- Prefix values become local state <- readLocal ctx name writeLocal ctx name $ addProperties props state CFUnsetProps scope name props -> case scope of - DefaultScope -> do + Nothing -> do state <- readVariable ctx name writeVariable ctx name $ removeProperties props state - GlobalScope -> do + Just GlobalScope -> do state <- readGlobal ctx name writeGlobal ctx name $ removeProperties props state - LocalScope -> do + Just LocalScope -> do out <- readSTRef (cOutput ctx) state <- readLocal ctx name writeLocal ctx name $ removeProperties props state - PrefixScope -> do + Just PrefixScope -> do -- Prefix values become local state <- readLocal ctx name writeLocal ctx name $ removeProperties props state From a47a42cb45e68050b84122a4bf237502b642350b Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Tue, 19 Dec 2023 02:17:59 -0500 Subject: [PATCH 136/244] Remove unnecessary partiality from isAssignmentParamToCommand --- src/ShellCheck/AnalyzerLib.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 4990822..1d53a98 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -341,9 +341,9 @@ isQuoteFreeNode strict shell tree t = -- Is this node self-quoting in itself? isQuoteFreeElement t = case t of - T_Assignment {} -> assignmentIsQuoting t - T_FdRedirect {} -> True - _ -> False + T_Assignment id _ _ _ _ -> assignmentIsQuoting id + T_FdRedirect {} -> True + _ -> False -- Are any subnodes inherently self-quoting? isQuoteFreeContext t = @@ -353,7 +353,7 @@ isQuoteFreeNode strict shell tree t = TC_Binary _ DoubleBracket _ _ _ -> return True TA_Sequence {} -> return True T_Arithmetic {} -> return True - T_Assignment {} -> return $ assignmentIsQuoting t + T_Assignment id _ _ _ _ -> return $ assignmentIsQuoting id T_Redirecting {} -> return False T_DoubleQuoted _ _ -> return True T_DollarDoubleQuoted _ _ -> return True @@ -368,11 +368,11 @@ isQuoteFreeNode strict shell tree t = -- Check whether this assignment is self-quoting due to being a recognized -- assignment passed to a Declaration Utility. This will soon be required -- by POSIX: https://austingroupbugs.net/view.php?id=351 - assignmentIsQuoting t = shellParsesParamsAsAssignments || not (isAssignmentParamToCommand t) + assignmentIsQuoting id = shellParsesParamsAsAssignments || not (isAssignmentParamToCommand id) shellParsesParamsAsAssignments = shell /= Sh -- Is this assignment a parameter to a command like export/typeset/etc? - isAssignmentParamToCommand (T_Assignment id _ _ _ _) = + isAssignmentParamToCommand id = case Map.lookup id tree of Just (T_SimpleCommand _ _ (_:args)) -> id `elem` (map getId args) _ -> False From bfe4342697292fe25a9214e30a0770fe0237ec42 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Tue, 19 Dec 2023 02:30:48 -0500 Subject: [PATCH 137/244] Remove unnecessary partiality from check --- src/ShellCheck/Checks/Commands.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 86fda24..314c1e9 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -1006,7 +1006,7 @@ checkWhileGetoptsCase = CommandCheck (Exactly "getopts") f options <- getLiteralString arg1 getoptsVar <- getLiteralString name (T_WhileExpression _ _ body) <- findFirst whileLoop path - caseCmd@(T_CaseExpression _ var _) <- mapMaybe findCase body !!! 0 + T_CaseExpression id var list <- mapMaybe findCase body !!! 0 -- Make sure getopts name and case variable matches [T_DollarBraced _ _ bracedWord] <- return $ getWordParts var @@ -1016,11 +1016,11 @@ checkWhileGetoptsCase = CommandCheck (Exactly "getopts") f -- Make sure the variable isn't modified guard . not $ modifiesVariable params (T_BraceGroup (Id 0) body) getoptsVar - return $ check (getId arg1) (map (:[]) $ filter (/= ':') options) caseCmd + return $ check (getId arg1) (map (:[]) $ filter (/= ':') options) id list f _ = return () - check :: Id -> [String] -> Token -> Analysis - check optId opts (T_CaseExpression id _ list) = do + check :: Id -> [String] -> Id -> [(CaseType, [Token], [Token])] -> Analysis + check optId opts id list = do unless (Nothing `M.member` handledMap) $ do mapM_ (warnUnhandled optId id) $ catMaybes $ M.keys notHandled From f983d9ae93e5eda28297a93a43640aafafa5f46c Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Thu, 21 Dec 2023 13:35:22 -0500 Subject: [PATCH 138/244] Simplify functionMap and remove unnecessary partiality --- src/ShellCheck/Analytics.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index b7844dd..19ff51b 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2825,13 +2825,11 @@ checkUnpassedInFunctions params root = execWriter $ mapM_ warnForGroup referenceGroups where functionMap :: Map.Map String Token - functionMap = Map.fromList $ - map (\t@(T_Function _ _ _ name _) -> (name,t)) functions - functions = execWriter $ doAnalysis (tell . maybeToList . findFunction) root + functionMap = Map.fromList $ execWriter $ doAnalysis (tell . maybeToList . findFunction) root findFunction t@(T_Function id _ _ name body) | any (isPositionalReference t) flow && not (any isPositionalAssignment flow) - = return t + = return (name,t) where flow = getVariableFlow params body findFunction _ = Nothing From dab77b2c8d978534603000e5406e604a79e1b195 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Thu, 21 Dec 2023 13:48:47 -0500 Subject: [PATCH 139/244] Implement parseEnum in terms of lookup --- shellcheck.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/shellcheck.hs b/shellcheck.hs index 6f12238..00b699b 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -252,9 +252,9 @@ runFormatter sys format options files = do else SomeProblems parseEnum name value list = - case filter ((== value) . fst) list of - [(name, value)] -> return value - [] -> do + case lookup value list of + Just value -> return value + Nothing -> do printErr $ "Unknown value for --" ++ name ++ ". " ++ "Valid options are: " ++ (intercalate ", " $ map fst list) throwError SupportFailure From 3bd7df955bdd9f066d5d19a90712b81305c61c87 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Fri, 29 Dec 2023 14:18:42 -0500 Subject: [PATCH 140/244] Use a pattern match instead of null and head in checkCommand --- src/ShellCheck/Checks/Commands.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 314c1e9..429e786 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -20,6 +20,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE PatternGuards #-} -- This module contains checks that examine specific commands by name. module ShellCheck.Checks.Commands (checker, optionalChecks, ShellCheck.Checks.Commands.runTests) where @@ -181,16 +182,15 @@ checkCommand :: M.Map CommandName (Token -> Analysis) -> Token -> Analysis checkCommand map t@(T_SimpleCommand id cmdPrefix (cmd:rest)) = sequence_ $ do name <- getLiteralString cmd return $ - if '/' `elem` name - then - M.findWithDefault nullCheck (Basename $ basename name) map t - else if name == "builtin" && not (null rest) then - let t' = T_SimpleCommand id cmdPrefix rest - selectedBuiltin = onlyLiteralString $ head rest - in M.findWithDefault nullCheck (Exactly selectedBuiltin) map t' - else do - M.findWithDefault nullCheck (Exactly name) map t - M.findWithDefault nullCheck (Basename name) map t + if | '/' `elem` name -> + M.findWithDefault nullCheck (Basename $ basename name) map t + | name == "builtin", (h:_) <- rest -> + let t' = T_SimpleCommand id cmdPrefix rest + selectedBuiltin = onlyLiteralString h + in M.findWithDefault nullCheck (Exactly selectedBuiltin) map t' + | otherwise -> do + M.findWithDefault nullCheck (Exactly name) map t + M.findWithDefault nullCheck (Basename name) map t where basename = reverse . takeWhile (/= '/') . reverse From dedf932fe8b9dcf4f852d4289032e6d25e7e5d40 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sat, 30 Dec 2023 13:59:15 -0500 Subject: [PATCH 141/244] Use traverse instead of sequence and map --- src/ShellCheck/Analytics.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 19ff51b..df0b3e6 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4936,7 +4936,7 @@ checkOverwrittenExitCode params t = guard . not $ S.null exitCodeIds let idToToken = idMap params - exitCodeTokens <- sequence $ map (\k -> Map.lookup k idToToken) $ S.toList exitCodeIds + exitCodeTokens <- traverse (\k -> Map.lookup k idToToken) $ S.toList exitCodeIds return $ do when (all isCondition exitCodeTokens && not (usedUnconditionally t exitCodeIds)) $ warn id 2319 "This $? refers to a condition, not a command. Assign to a variable to avoid it being overwritten." From 980e7d3ca8aa19977ca517b846e2d2cff4fb1c5d Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sat, 30 Dec 2023 14:49:26 -0500 Subject: [PATCH 142/244] Use <$> instead of >>= and return --- src/ShellCheck/CFG.hs | 2 +- src/ShellCheck/Parser.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index ed6a8f8..5d018c8 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -997,7 +997,7 @@ handleCommand cmd vars args literalCmd = do (names, flags) = partition (null . fst) pairs flagNames = map fst flags literalNames :: [(Token, String)] -- Literal names to unset, e.g. [(myfuncToken, "myfunc")] - literalNames = mapMaybe (\(_, t) -> getLiteralString t >>= (return . (,) t)) names + literalNames = mapMaybe (\(_, t) -> (,) t <$> getLiteralString t) names -- Apply a constructor like CFUndefineVariable to each literalName, and tag with its id unsetWith c = newNodeRange $ CFApplyEffects $ map (\(token, name) -> IdTagged (getId token) $ c name) literalNames diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 04bdbc4..37a9b86 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -1195,7 +1195,7 @@ readDollarBracedPart = readSingleQuoted <|> readDoubleQuoted <|> readDollarBracedLiteral = do start <- startSpan - vars <- (readBraceEscaped <|> (anyChar >>= \x -> return [x])) `reluctantlyTill1` bracedQuotable + vars <- (readBraceEscaped <|> ((\x -> [x]) <$> anyChar)) `reluctantlyTill1` bracedQuotable id <- endSpan start return $ T_Literal id $ concat vars @@ -1557,7 +1557,7 @@ readGenericLiteral endChars = do return $ concat strings readGenericLiteral1 endExp = do - strings <- (readGenericEscaped <|> (anyChar >>= \x -> return [x])) `reluctantlyTill1` endExp + strings <- (readGenericEscaped <|> ((\x -> [x]) <$> anyChar)) `reluctantlyTill1` endExp return $ concat strings readGenericEscaped = do @@ -2371,7 +2371,7 @@ readPipeSequence = do return $ T_Pipeline id pipes cmds where sepBy1WithSeparators p s = do - let elems = p >>= \x -> return ([x], []) + let elems = (\x -> ([x], [])) <$> p let seps = do separator <- s return $ \(a,b) (c,d) -> (a++c, b ++ d ++ [separator]) From ee41c780f4a587cd32c58deb8badc27dac2b6b10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Otto=20Kek=C3=A4l=C3=A4inen?= Date: Sun, 31 Dec 2023 10:47:40 +0800 Subject: [PATCH 143/244] Replace Atom reference with Pulsar Edit equivalent Since Microsoft acquired GitHub and discontinued Atom in 2022, the community started a fork at https://pulsar-edit.dev/. Linking to an archived repository under the Atom organization does not make sense anymore, so link to active Pulsar fork instead. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 9d98b9d..b9aea08 100644 --- a/README.md +++ b/README.md @@ -77,7 +77,7 @@ You can see ShellCheck suggestions directly in a variety of editors. * Sublime, through [SublimeLinter](https://github.com/SublimeLinter/SublimeLinter-shellcheck). -* Atom, through [Linter](https://github.com/AtomLinter/linter-shellcheck). +* Pulsar Edit (former Atom), through [linter-shellcheck-pulsar](https://github.com/pulsar-cooperative/linter-shellcheck-pulsar). * VSCode, through [vscode-shellcheck](https://github.com/timonwong/vscode-shellcheck). From e1ad06383425f46703a26aafc0d1bdc8ddc90a18 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 01:59:53 -0500 Subject: [PATCH 144/244] Implement getPath in terms of unfoldr --- src/ShellCheck/ASTLib.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index cf55498..5b3ffd8 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -897,10 +897,9 @@ getUnmodifiedParameterExpansion t = _ -> Nothing --- A list of the element and all its parents up to the root node. -getPath tree t = t : - case Map.lookup (getId t) tree of - Nothing -> [] - Just parent -> getPath tree parent +getPath tree t = t : unfoldr go t + where + go s = (\x -> (x,x)) <$> Map.lookup (getId s) tree isClosingFileOp op = case op of From add49cda171058b921fb57a2b658511159858a1f Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 02:12:58 -0500 Subject: [PATCH 145/244] Make getPath return a NonEmpty --- src/ShellCheck/ASTLib.hs | 5 ++- src/ShellCheck/Analytics.hs | 59 ++++++++++++++++--------------- src/ShellCheck/AnalyzerLib.hs | 11 +++--- src/ShellCheck/Checks/Commands.hs | 3 +- 4 files changed, 40 insertions(+), 38 deletions(-) diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 5b3ffd8..aadff05 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -31,6 +31,7 @@ import Data.Functor import Data.Functor.Identity import Data.List import Data.Maybe +import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import Numeric (showHex) @@ -897,9 +898,7 @@ getUnmodifiedParameterExpansion t = _ -> Nothing --- A list of the element and all its parents up to the root node. -getPath tree t = t : unfoldr go t - where - go s = (\x -> (x,x)) <$> Map.lookup (getId s) tree +getPath tree = NE.unfoldr $ \t -> (t, Map.lookup (getId t) tree) isClosingFileOp op = case op of diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index df0b3e6..e80ed58 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -46,6 +46,7 @@ import Data.Maybe import Data.Ord import Data.Semigroup import Debug.Trace -- STRIP +import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import qualified Data.Set as S import Test.QuickCheck.All (forAllProperties) @@ -846,14 +847,14 @@ checkRedirectToSame params s@(T_Pipeline _ _ list) = getRedirs _ = [] special x = "/dev/" `isPrefixOf` concat (oversimplify x) isInput t = - case drop 1 $ getPath (parentMap params) t of + case NE.tail $ getPath (parentMap params) t of T_IoFile _ op _:_ -> case op of T_Less _ -> True _ -> False _ -> False isOutput t = - case drop 1 $ getPath (parentMap params) t of + case NE.tail $ getPath (parentMap params) t of T_IoFile _ op _:_ -> case op of T_Greater _ -> True @@ -887,7 +888,7 @@ checkShorthandIf params x@(T_OrIf _ (T_AndIf id _ _) (T_Pipeline _ _ t)) name <- getCommandBasename t return $ name `elem` ["echo", "exit", "return", "printf"]) isOk _ = False - inCondition = isCondition $ getPath (parentMap params) x + inCondition = isCondition $ NE.toList $ getPath (parentMap params) x checkShorthandIf _ _ = return () @@ -1087,7 +1088,7 @@ checkSingleQuotedVariables params t@(T_SingleQuoted id s) = return $ if name == "find" then getFindCommand cmd else if name == "git" then getGitCommand cmd else if name == "mumps" then getMumpsCommand cmd else name isProbablyOk = - any isOkAssignment (take 3 $ getPath parents t) + any isOkAssignment (NE.take 3 $ getPath parents t) || commandName `elem` [ "trap" ,"sh" @@ -1495,7 +1496,7 @@ checkArithmeticDeref params t@(TA_Expansion _ [T_DollarBraced id _ l]) = where isException [] = True isException s@(h:_) = any (`elem` "/.:#%?*@$-!+=^,") s || isDigit h - getWarning = fromMaybe noWarning . msum . map warningFor $ parents params t + getWarning = fromMaybe noWarning . msum . NE.map warningFor $ parents params t warningFor t = case t of T_Arithmetic {} -> return normalWarning @@ -1823,7 +1824,7 @@ checkInexplicablyUnquoted params (T_NormalWord id tokens) = mapM_ check (tails t T_Literal id s | not (quotesSingleThing a && quotesSingleThing b || s `elem` ["=", ":", "/"] - || isSpecial (getPath (parentMap params) trapped) + || isSpecial (NE.toList $ getPath (parentMap params) trapped) ) -> warnAboutLiteral id _ -> return () @@ -2041,7 +2042,7 @@ doVariableFlowAnalysis readFunc writeFunc empty flow = evalState ( -- from $foo=bar to foo=bar. This is not pretty but ok. quotesMayConflictWithSC2281 params t = case getPath (parentMap params) t of - _ : T_NormalWord parentId (me:T_Literal _ ('=':_):_) : T_SimpleCommand _ _ (cmd:_) : _ -> + _ NE.:| T_NormalWord parentId (me:T_Literal _ ('=':_):_) : T_SimpleCommand _ _ (cmd:_) : _ -> (getId t) == (getId me) && (parentId == getId cmd) _ -> False @@ -2652,7 +2653,7 @@ checkPrefixAssignmentReference params t@(T_DollarBraced id _ value) = check path where name = getBracedReference $ concat $ oversimplify value - path = getPath (parentMap params) t + path = NE.toList $ getPath (parentMap params) t idPath = map getId path check [] = return () @@ -2701,7 +2702,7 @@ checkCharRangeGlob p t@(T_Glob id str) | return $ isCommandMatch cmd (`elem` ["tr", "read"]) -- Check if this is a dereferencing context like [[ -v array[operandhere] ]] - isDereferenced = fromMaybe False . msum . map isDereferencingOp . getPath (parentMap p) + isDereferenced = fromMaybe False . msum . NE.map isDereferencingOp . getPath (parentMap p) isDereferencingOp t = case t of TC_Binary _ DoubleBracket str _ _ -> return $ isDereferencingBinaryOp str @@ -2764,7 +2765,7 @@ checkLoopKeywordScope params t | _ -> return () where name = getCommandName t - path = let p = getPath (parentMap params) t in filter relevant p + path = let p = getPath (parentMap params) t in NE.filter relevant p subshellType t = case leadType params t of NoneScope -> Nothing SubshellScope str -> return str @@ -3188,7 +3189,7 @@ checkUncheckedCdPushdPopd params root = | name `elem` ["cd", "pushd", "popd"] && not (isSafeDir t) && not (name `elem` ["pushd", "popd"] && ("n" `elem` map snd (getAllFlags t))) - && not (isCondition $ getPath (parentMap params) t) = + && not (isCondition $ NE.toList $ getPath (parentMap params) t) = warnWithFix (getId t) 2164 ("Use '" ++ name ++ " ... || exit' or '" ++ name ++ " ... || return' in case " ++ name ++ " fails.") (fixWith [replaceEnd (getId t) params 0 " || exit"]) @@ -3217,7 +3218,7 @@ checkLoopVariableReassignment params token = return $ do warn (getId token) 2165 "This nested loop overrides the index variable of its parent." warn (getId next) 2167 "This parent loop has its index variable overridden." - path = drop 1 $ getPath (parentMap params) token + path = NE.tail $ getPath (parentMap params) token loopVariable :: Token -> Maybe String loopVariable t = case t of @@ -3290,17 +3291,17 @@ checkReturnAgainstZero params token = -- We don't want to warn about composite expressions like -- [[ $? -eq 0 || $? -eq 4 ]] since these can be annoying to rewrite. isOnlyTestInCommand t = - case getPath (parentMap params) t of - _:(T_Condition {}):_ -> True - _:(T_Arithmetic {}):_ -> True - _:(TA_Sequence _ [_]):(T_Arithmetic {}):_ -> True + case NE.tail $ getPath (parentMap params) t of + (T_Condition {}):_ -> True + (T_Arithmetic {}):_ -> True + (TA_Sequence _ [_]):(T_Arithmetic {}):_ -> True -- Some negations and groupings are also fine - _:next@(TC_Unary _ _ "!" _):_ -> isOnlyTestInCommand next - _:next@(TA_Unary _ "!" _):_ -> isOnlyTestInCommand next - _:next@(TC_Group {}):_ -> isOnlyTestInCommand next - _:next@(TA_Sequence _ [_]):_ -> isOnlyTestInCommand next - _:next@(TA_Parentesis _ _):_ -> isOnlyTestInCommand next + next@(TC_Unary _ _ "!" _):_ -> isOnlyTestInCommand next + next@(TA_Unary _ "!" _):_ -> isOnlyTestInCommand next + next@(TC_Group {}):_ -> isOnlyTestInCommand next + next@(TA_Sequence _ [_]):_ -> isOnlyTestInCommand next + next@(TA_Parentesis _ _):_ -> isOnlyTestInCommand next _ -> False -- TODO: Do better $? tracking and filter on whether @@ -3365,7 +3366,7 @@ checkRedirectedNowhere params token = _ -> return () where isInExpansion t = - case drop 1 $ getPath (parentMap params) t of + case NE.tail $ getPath (parentMap params) t of T_DollarExpansion _ [_] : _ -> True T_Backticked _ [_] : _ -> True t@T_Annotation {} : _ -> isInExpansion t @@ -3839,7 +3840,7 @@ checkSubshelledTests params t = isFunctionBody path = case path of - (_:f:_) -> isFunction f + (_ NE.:| f:_) -> isFunction f _ -> False isTestStructure t = @@ -3866,7 +3867,7 @@ checkSubshelledTests params t = -- This technically also triggers for `if true; then ( test ); fi` -- but it's still a valid suggestion. isCompoundCondition chain = - case dropWhile skippable (drop 1 chain) of + case dropWhile skippable (NE.tail chain) of T_IfExpression {} : _ -> True T_WhileExpression {} : _ -> True T_UntilExpression {} : _ -> True @@ -4005,7 +4006,7 @@ checkUselessBang params t = when (hasSetE params) $ mapM_ check (getNonReturning where check t = case t of - T_Banged id cmd | not $ isCondition (getPath (parentMap params) t) -> + T_Banged id cmd | not $ isCondition (NE.toList $ getPath (parentMap params) t) -> addComment $ makeCommentWithFix InfoC id 2251 "This ! is not on a condition and skips errexit. Use `&& exit 1` instead, or make sure $? is checked." (fixWith [replaceStart id params 1 "", replaceEnd (getId cmd) params 0 " && exit 1"]) @@ -4029,7 +4030,7 @@ checkUselessBang params t = when (hasSetE params) $ mapM_ check (getNonReturning isFunctionBody t = case getPath (parentMap params) t of - _:T_Function {}:_-> True + _ NE.:| T_Function {}:_-> True _ -> False dropLast t = @@ -4627,7 +4628,7 @@ checkArrayValueUsedAsIndex params _ = -- Is this one of the 'for' arrays? (loopWord, _) <- find ((==arrayName) . snd) arrays -- Are we still in this loop? - guard $ getId loop `elem` map getId (getPath parents t) + guard $ getId loop `elem` NE.map getId (getPath parents t) return [ makeComment WarningC (getId loopWord) 2302 "This loops over values. To loop over keys, use \"${!array[@]}\".", makeComment WarningC (getId arrayRef) 2303 $ (e4m name) ++ " is an array value, not a key. Use directly or loop over keys instead." @@ -4709,7 +4710,7 @@ checkSetESuppressed params t = literalArg <- getUnquotedLiteral cmd Map.lookup literalArg functions_ - checkCmd cmd = go $ getPath (parentMap params) cmd + checkCmd cmd = go $ NE.toList $ getPath (parentMap params) cmd where go (child:parent:rest) = do case parent of @@ -4855,7 +4856,7 @@ checkExtraMaskedReturns params t = basename <- getCommandBasename t return $ basename == "time" - parentChildPairs t = go $ parents params t + parentChildPairs t = go $ NE.toList $ parents params t where go (child:parent:rest) = (parent, child):go (parent:rest) go _ = [] diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 1d53a98..21123d4 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -41,6 +41,7 @@ import Data.Char import Data.List import Data.Maybe import Data.Semigroup +import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import Test.QuickCheck.All (forAllProperties) @@ -336,7 +337,7 @@ isQuoteFree = isQuoteFreeNode False isQuoteFreeNode strict shell tree t = isQuoteFreeElement t || - (fromMaybe False $ msum $ map isQuoteFreeContext $ drop 1 $ getPath tree t) + (fromMaybe False $ msum $ map isQuoteFreeContext $ NE.tail $ getPath tree t) where -- Is this node self-quoting in itself? isQuoteFreeElement t = @@ -398,7 +399,7 @@ isParamTo tree cmd = -- Get the parent command (T_Redirecting) of a Token, if any. getClosestCommand :: Map.Map Id Token -> Token -> Maybe Token getClosestCommand tree t = - findFirst findCommand $ getPath tree t + findFirst findCommand $ NE.toList $ getPath tree t where findCommand t = case t of @@ -412,7 +413,7 @@ getClosestCommandM t = do return $ getClosestCommand (parentMap params) t -- Is the token used as a command name (the first word in a T_SimpleCommand)? -usedAsCommandName tree token = go (getId token) (tail $ getPath tree token) +usedAsCommandName tree token = go (getId token) (NE.tail $ getPath tree token) where go currentId (T_NormalWord id [word]:rest) | currentId == getId word = go id rest @@ -429,7 +430,7 @@ getPathM t = do return $ getPath (parentMap params) t isParentOf tree parent child = - elem (getId parent) . map getId $ getPath tree child + elem (getId parent) . NE.map getId $ getPath tree child parents params = getPath (parentMap params) @@ -813,7 +814,7 @@ getReferencedVariables parents t = return (context, token, getBracedReference str) isArithmeticAssignment t = case getPath parents t of - this: TA_Assignment _ "=" lhs _ :_ -> lhs == t + this NE.:| TA_Assignment _ "=" lhs _ :_ -> lhs == t _ -> False isDereferencingBinaryOp = (`elem` ["-eq", "-ne", "-lt", "-le", "-gt", "-ge"]) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 429e786..c4ffd87 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -43,6 +43,7 @@ import Data.Functor.Identity import qualified Data.Graph.Inductive.Graph as G import Data.List import Data.Maybe +import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as M import qualified Data.Set as S import Test.QuickCheck.All (forAllProperties) @@ -1005,7 +1006,7 @@ checkWhileGetoptsCase = CommandCheck (Exactly "getopts") f sequence_ $ do options <- getLiteralString arg1 getoptsVar <- getLiteralString name - (T_WhileExpression _ _ body) <- findFirst whileLoop path + (T_WhileExpression _ _ body) <- findFirst whileLoop (NE.toList path) T_CaseExpression id var list <- mapMaybe findCase body !!! 0 -- Make sure getopts name and case variable matches From 71c0fcb737e94d7f2aa65e0540ddc2554f63bdd7 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 02:27:52 -0500 Subject: [PATCH 146/244] Manually fuse elem and map in isParentOf --- src/ShellCheck/AnalyzerLib.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 21123d4..944b12d 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -430,7 +430,9 @@ getPathM t = do return $ getPath (parentMap params) t isParentOf tree parent child = - elem (getId parent) . NE.map getId $ getPath tree child + any (\t -> parentId == getId t) (getPath tree child) + where + parentId = getId parent parents params = getPath (parentMap params) From 6e5b5401c6e593c82ce11ab15b532fe3a9c07d3b Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 02:31:07 -0500 Subject: [PATCH 147/244] Manually fuse elem and map in checkArrayValueUsedAsIndex --- src/ShellCheck/Analytics.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e80ed58..9926462 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4628,7 +4628,8 @@ checkArrayValueUsedAsIndex params _ = -- Is this one of the 'for' arrays? (loopWord, _) <- find ((==arrayName) . snd) arrays -- Are we still in this loop? - guard $ getId loop `elem` NE.map getId (getPath parents t) + let loopId = getId loop + guard $ any (\t -> loopId == getId t) (getPath parents t) return [ makeComment WarningC (getId loopWord) 2302 "This loops over values. To loop over keys, use \"${!array[@]}\".", makeComment WarningC (getId arrayRef) 2303 $ (e4m name) ++ " is an array value, not a key. Use directly or loop over keys instead." From a786f996a176555ca5c09866dcb785cf7fd9323d Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 15:55:06 -0500 Subject: [PATCH 148/244] Replace !!! with pattern-matching where it's easy --- src/ShellCheck/Analytics.hs | 14 +++++--------- src/ShellCheck/Checks/Commands.hs | 3 +-- src/ShellCheck/Checks/ShellSupport.hs | 5 ++--- 3 files changed, 8 insertions(+), 14 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 9926462..2fb3185 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -468,9 +468,8 @@ checkAssignAteCommand _ (T_SimpleCommand id [T_Assignment _ _ _ _ assignmentTerm where isCommonCommand (Just s) = s `elem` commonCommands isCommonCommand _ = False - firstWordIsArg list = fromMaybe False $ do - head <- list !!! 0 - return $ isGlob head || isUnquotedFlag head + firstWordIsArg (head:_) = isGlob head || isUnquotedFlag head + firstWordIsArg [] = False checkAssignAteCommand _ _ = return () @@ -491,9 +490,7 @@ prop_checkWrongArit2 = verify checkWrongArithmeticAssignment "n=2; i=n*2" checkWrongArithmeticAssignment params (T_SimpleCommand id [T_Assignment _ _ _ _ val] []) = sequence_ $ do str <- getNormalString val - match <- matchRegex regex str - var <- match !!! 0 - op <- match !!! 1 + var:op:_ <- matchRegex regex str Map.lookup var references return . warn (getId val) 2100 $ "Use $((..)) for arithmetics, e.g. i=$((i " ++ op ++ " 2))" @@ -1460,9 +1457,8 @@ prop_checkForDecimals2 = verify checkForDecimals "foo[1.2]=bar" prop_checkForDecimals3 = verifyNot checkForDecimals "declare -A foo; foo[1.2]=bar" checkForDecimals params t@(TA_Expansion id _) = sequence_ $ do guard $ not (hasFloatingPoint params) - str <- getLiteralString t - first <- str !!! 0 - guard $ isDigit first && '.' `elem` str + first:rest <- getLiteralString t + guard $ isDigit first && '.' `elem` rest return $ err id 2079 "(( )) doesn't support decimals. Use bc or awk." checkForDecimals _ _ = return () diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index c4ffd87..97c9088 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -1237,8 +1237,7 @@ checkSudoArgs = CommandCheck (Basename "sudo") f where f t = sequence_ $ do opts <- parseOpts $ arguments t - let nonFlags = [x | ("",(x, _)) <- opts] - commandArg <- nonFlags !!! 0 + (_,(commandArg, _)) <- find (null . fst) opts command <- getLiteralString commandArg guard $ command `elem` builtins return $ warn (getId t) 2232 $ "Can't use sudo with builtins like " ++ command ++ ". Did you want sudo sh -c .. instead?" diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index d070497..cab0546 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -79,9 +79,8 @@ prop_checkForDecimals3 = verifyNot checkForDecimals "declare -A foo; foo[1.2]=ba checkForDecimals = ForShell [Sh, Dash, BusyboxSh, Bash] f where f t@(TA_Expansion id _) = sequence_ $ do - str <- getLiteralString t - first <- str !!! 0 - guard $ isDigit first && '.' `elem` str + first:rest <- getLiteralString t + guard $ isDigit first && '.' `elem` rest return $ err id 2079 "(( )) doesn't support decimals. Use bc or awk." f _ = return () From 10afe83ce32c575cace720b51516092a44d39cf2 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 16:23:45 -0500 Subject: [PATCH 149/244] Use getLiteralStringDef instead of rebuilding it with fromJust --- src/ShellCheck/Analytics.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 2fb3185..d030812 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4509,7 +4509,7 @@ prop_checkCommandWithTrailingSymbol9 = verifyNot checkCommandWithTrailingSymbol checkCommandWithTrailingSymbol _ t = case t of T_SimpleCommand _ _ (cmd:_) -> - let str = fromJust $ getLiteralStringExt (\_ -> Just "x") cmd + let str = getLiteralStringDef "x" cmd last = lastOrDefault 'x' str in case str of From 6c81505870d84747c7614deebc2770f38c3e4c29 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 16:26:03 -0500 Subject: [PATCH 150/244] Use a pattern guard instead of fromJust in checkLoopKeywordScope --- src/ShellCheck/Analytics.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index d030812..6daf614 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -19,6 +19,7 @@ -} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PatternGuards #-} module ShellCheck.Analytics (checker, optionalChecks, ShellCheck.Analytics.runTests) where import ShellCheck.AST @@ -2749,18 +2750,17 @@ prop_checkLoopKeywordScope5 = verify checkLoopKeywordScope "if true; then break; prop_checkLoopKeywordScope6 = verify checkLoopKeywordScope "while true; do true | { break; }; done" prop_checkLoopKeywordScope7 = verifyNot checkLoopKeywordScope "#!/bin/ksh\nwhile true; do true | { break; }; done" checkLoopKeywordScope params t | - name `elem` map Just ["continue", "break"] = + Just name <- getCommandName t, name `elem` ["continue", "break"] = if not $ any isLoop path then if any isFunction $ take 1 path -- breaking at a source/function invocation is an abomination. Let's ignore it. - then err (getId t) 2104 $ "In functions, use return instead of " ++ fromJust name ++ "." - else err (getId t) 2105 $ fromJust name ++ " is only valid in loops." + then err (getId t) 2104 $ "In functions, use return instead of " ++ name ++ "." + else err (getId t) 2105 $ name ++ " is only valid in loops." else case map subshellType $ filter (not . isFunction) path of Just str:_ -> warn (getId t) 2106 $ "This only exits the subshell caused by the " ++ str ++ "." _ -> return () where - name = getCommandName t path = let p = getPath (parentMap params) t in NE.filter relevant p subshellType t = case leadType params t of NoneScope -> Nothing From 3f40b688eee018f49b0a2ed7d8805987eb4118cd Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 16:33:34 -0500 Subject: [PATCH 151/244] Simplify getStringFromParsec --- src/ShellCheck/Parser.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 37a9b86..130d956 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -3456,9 +3456,8 @@ makeErrorFor parsecError = pos = errorPos parsecError getStringFromParsec errors = - case map f errors of - r -> unwords (take 1 $ catMaybes $ reverse r) ++ - " Fix any mentioned problems and try again." + headOrDefault "" (mapMaybe f $ reverse errors) ++ + " Fix any mentioned problems and try again." where f err = case err of From a6984cddb0fbead307dce4bd98a66f8225ea2888 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 16:40:18 -0500 Subject: [PATCH 152/244] Switch then and else to remove a not --- src/ShellCheck/Analytics.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 6daf614..ae29762 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2751,15 +2751,15 @@ prop_checkLoopKeywordScope6 = verify checkLoopKeywordScope "while true; do true prop_checkLoopKeywordScope7 = verifyNot checkLoopKeywordScope "#!/bin/ksh\nwhile true; do true | { break; }; done" checkLoopKeywordScope params t | Just name <- getCommandName t, name `elem` ["continue", "break"] = - if not $ any isLoop path - then if any isFunction $ take 1 path - -- breaking at a source/function invocation is an abomination. Let's ignore it. - then err (getId t) 2104 $ "In functions, use return instead of " ++ name ++ "." - else err (getId t) 2105 $ name ++ " is only valid in loops." - else case map subshellType $ filter (not . isFunction) path of + if any isLoop path + then case map subshellType $ filter (not . isFunction) path of Just str:_ -> warn (getId t) 2106 $ "This only exits the subshell caused by the " ++ str ++ "." _ -> return () + else if any isFunction $ take 1 path + -- breaking at a source/function invocation is an abomination. Let's ignore it. + then err (getId t) 2104 $ "In functions, use return instead of " ++ name ++ "." + else err (getId t) 2105 $ name ++ " is only valid in loops." where path = let p = getPath (parentMap params) t in NE.filter relevant p subshellType t = case leadType params t of From 71889c139aac3ce3597349878c746c774b329882 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 16:44:21 -0500 Subject: [PATCH 153/244] Use a case expression instead of any and take 1 --- src/ShellCheck/Analytics.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index ae29762..ca679bb 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2756,10 +2756,10 @@ checkLoopKeywordScope params t | Just str:_ -> warn (getId t) 2106 $ "This only exits the subshell caused by the " ++ str ++ "." _ -> return () - else if any isFunction $ take 1 path + else case path of -- breaking at a source/function invocation is an abomination. Let's ignore it. - then err (getId t) 2104 $ "In functions, use return instead of " ++ name ++ "." - else err (getId t) 2105 $ name ++ " is only valid in loops." + h:_ | isFunction h -> err (getId t) 2104 $ "In functions, use return instead of " ++ name ++ "." + _ -> err (getId t) 2105 $ name ++ " is only valid in loops." where path = let p = getPath (parentMap params) t in NE.filter relevant p subshellType t = case leadType params t of From 7b0589988fca3bf234d2d62e475f2e821ddb42c5 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 17:21:50 -0500 Subject: [PATCH 154/244] Implement isCondition in terms of foldr --- src/ShellCheck/Analytics.hs | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index ca679bb..3f686ee 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -346,13 +346,11 @@ dist a b hasFloatingPoint params = shellType params == Ksh -- Checks whether the current parent path is part of a condition -isCondition [] = False -isCondition [_] = False -isCondition (child:parent:rest) = - case child of - T_BatsTest {} -> True -- count anything in a @test as conditional - _ -> getId child `elem` map getId (getConditionChildren parent) || isCondition (parent:rest) +isCondition (x NE.:| xs) = foldr go (const False) xs x where + go _ _ T_BatsTest{} = True -- count anything in a @test as conditional + go parent go_rest child = + getId child `elem` map getId (getConditionChildren parent) || go_rest parent getConditionChildren t = case t of T_AndIf _ left right -> [left] @@ -886,7 +884,7 @@ checkShorthandIf params x@(T_OrIf _ (T_AndIf id _ _) (T_Pipeline _ _ t)) name <- getCommandBasename t return $ name `elem` ["echo", "exit", "return", "printf"]) isOk _ = False - inCondition = isCondition $ NE.toList $ getPath (parentMap params) x + inCondition = isCondition $ getPath (parentMap params) x checkShorthandIf _ _ = return () @@ -3185,7 +3183,7 @@ checkUncheckedCdPushdPopd params root = | name `elem` ["cd", "pushd", "popd"] && not (isSafeDir t) && not (name `elem` ["pushd", "popd"] && ("n" `elem` map snd (getAllFlags t))) - && not (isCondition $ NE.toList $ getPath (parentMap params) t) = + && not (isCondition $ getPath (parentMap params) t) = warnWithFix (getId t) 2164 ("Use '" ++ name ++ " ... || exit' or '" ++ name ++ " ... || return' in case " ++ name ++ " fails.") (fixWith [replaceEnd (getId t) params 0 " || exit"]) @@ -4002,7 +4000,7 @@ checkUselessBang params t = when (hasSetE params) $ mapM_ check (getNonReturning where check t = case t of - T_Banged id cmd | not $ isCondition (NE.toList $ getPath (parentMap params) t) -> + T_Banged id cmd | not $ isCondition (getPath (parentMap params) t) -> addComment $ makeCommentWithFix InfoC id 2251 "This ! is not on a condition and skips errexit. Use `&& exit 1` instead, or make sure $? is checked." (fixWith [replaceStart id params 1 "", replaceEnd (getId cmd) params 0 " && exit 1"]) From b7f88ec4b72bae672f1b77e4af312990f17ab86b Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 18:09:02 -0500 Subject: [PATCH 155/244] Stop building tuples that we never look at both sides of --- src/ShellCheck/Analytics.hs | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 3f686ee..9913b09 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4819,15 +4819,15 @@ checkExtraMaskedReturns params t = ++ "separately to avoid masking its return value (or use '|| true' " ++ "to ignore).") - isMaskDeliberate t = hasParent isOrIf t + isMaskDeliberate t = any isOrIf $ NE.init $ parents params t where - isOrIf _ (T_OrIf _ _ (T_Pipeline _ _ [T_Redirecting _ _ cmd])) + isOrIf (T_OrIf _ _ (T_Pipeline _ _ [T_Redirecting _ _ cmd])) = getCommandBasename cmd `elem` [Just "true", Just ":"] - isOrIf _ _ = False + isOrIf _ = False - isCheckedElsewhere t = hasParent isDeclaringCommand t + isCheckedElsewhere t = any isDeclaringCommand $ NE.tail $ parents params t where - isDeclaringCommand t _ = fromMaybe False $ do + isDeclaringCommand t = fromMaybe False $ do cmd <- getCommand t basename <- getCommandBasename cmd return $ @@ -4851,13 +4851,6 @@ checkExtraMaskedReturns params t = basename <- getCommandBasename t return $ basename == "time" - parentChildPairs t = go $ NE.toList $ parents params t - where - go (child:parent:rest) = (parent, child):go (parent:rest) - go _ = [] - - hasParent pred t = any (uncurry pred) (parentChildPairs t) - -- hard error on negated command that is not last prop_checkBatsTestDoesNotUseNegation1 = verify checkBatsTestDoesNotUseNegation "#!/usr/bin/env/bats\n@test \"name\" { ! true; false; }" From 9e0fdbe431f6a9725a461b214c97f885782f0314 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 31 Dec 2023 18:13:32 -0500 Subject: [PATCH 156/244] Simplify isTransparentCommand --- src/ShellCheck/Analytics.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 9913b09..71caa62 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4847,9 +4847,7 @@ checkExtraMaskedReturns params t = ,"shopt" ] - isTransparentCommand t = fromMaybe False $ do - basename <- getCommandBasename t - return $ basename == "time" + isTransparentCommand t = getCommandBasename t == Just "time" -- hard error on negated command that is not last From 5a6f4840adf584da60273c6b8145c19fd7e342a4 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 1 Jan 2024 14:16:50 -0500 Subject: [PATCH 157/244] Replace a few more occurrences of !!! with pattern matching --- src/ShellCheck/ASTLib.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index aadff05..9b151c2 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -858,8 +858,7 @@ getBracedModifier s = headOrDefault "" $ do -- Get the variables from indices like ["x", "y"] in ${var[x+y+1]} prop_getIndexReferences1 = getIndexReferences "var[x+y+1]" == ["x", "y"] getIndexReferences s = fromMaybe [] $ do - match <- matchRegex re s - index <- match !!! 0 + index:_ <- matchRegex re s return $ matchAllStrings variableNameRegex index where re = mkRegex "(\\[.*\\])" @@ -870,8 +869,7 @@ prop_getOffsetReferences3 = getOffsetReferences "[foo]:bar" == ["bar"] prop_getOffsetReferences4 = getOffsetReferences "[foo]:bar:baz" == ["bar", "baz"] getOffsetReferences mods = fromMaybe [] $ do -- if mods start with [, then drop until ] - match <- matchRegex re mods - offsets <- match !!! 1 + _:offsets:_ <- matchRegex re mods return $ matchAllStrings variableNameRegex offsets where re = mkRegex "^(\\[.+\\])? *:([^-=?+].*)" From 025cc5266ec1632d5f524644f0366237f604e7e8 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 1 Jan 2024 16:00:19 -0500 Subject: [PATCH 158/244] Simplify isUnquotedFlag --- src/ShellCheck/ASTLib.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 9b151c2..88089ea 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -158,9 +158,10 @@ isFlag token = _ -> False -- Is this token a flag where the - is unquoted? -isUnquotedFlag token = fromMaybe False $ do - str <- getLeadingUnquotedString token - return $ "-" `isPrefixOf` str +isUnquotedFlag token = + case getLeadingUnquotedString token of + Just ('-':_) -> True + _ -> False -- getGnuOpts "erd:u:" will parse a list of arguments tokens like `read` -- -re -d : -u 3 bar From 67abfe159e41e33a7ad17d9b5e130756cc447510 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 1 Jan 2024 19:04:26 -0500 Subject: [PATCH 159/244] Remove most of the partial head and tail functions from src/ShellCheck/CFG.hs --- src/ShellCheck/CFG.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index 5d018c8..e1d3259 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -615,15 +615,15 @@ build t = do T_CaseExpression id t [] -> build t - T_CaseExpression id t list -> do + T_CaseExpression id t list@(hd:tl) -> do start <- newStructuralNode token <- build t - branches <- mapM buildBranch list + branches <- mapM buildBranch (hd NE.:| tl) end <- newStructuralNode - let neighbors = zip branches $ tail branches - let (_, firstCond, _) = head branches - let (_, lastCond, lastBody) = last branches + let neighbors = zip (NE.toList branches) $ NE.tail branches + let (_, firstCond, _) = NE.head branches + let (_, lastCond, lastBody) = NE.last branches linkRange start token linkRange token firstCond From ba86c6363c30a5dbefd0b8b9a7c5f4ab0478dc91 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Tue, 2 Jan 2024 14:46:07 -0500 Subject: [PATCH 160/244] Use maybe instead of fromMaybe and fmap --- src/ShellCheck/Analytics.hs | 2 +- src/ShellCheck/CFGAnalysis.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 71caa62..3af0455 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -5020,7 +5020,7 @@ checkPlusEqualsNumber params t = let unquotedLiteral = getUnquotedLiteral word isEmpty = unquotedLiteral == Just "" - isUnquotedNumber = not isEmpty && fromMaybe False (all isDigit <$> unquotedLiteral) + isUnquotedNumber = not isEmpty && maybe False (all isDigit) unquotedLiteral isNumericalVariableName = fromMaybe False $ do str <- unquotedLiteral CF.variableMayBeAssignedInteger state str diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 16afa68..0b99c9f 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -829,7 +829,7 @@ lookupStack' functionOnly get dep def ctx key = do f (s:rest) = do -- Go up the stack until we find the value, and add -- a dependency on each state (including where it was found) - res <- fromMaybe (f rest) (return <$> get (stackState s) key) + res <- maybe (f rest) return (get (stackState s) key) modifySTRef (dependencies s) $ S.insert $ dep key res return res From 1bce426fcfd6ff176800bd70d7a298cf261d8512 Mon Sep 17 00:00:00 2001 From: Georg Pfuetzenreuter Date: Sun, 21 Jan 2024 02:16:35 +0100 Subject: [PATCH 161/244] Implement rcfile option This introduces the "--rcfile" argument which allows a specific shellcheckrc file to be passed. If specified and the given file exists, the default locations will not be searched and the specified file will be used. Signed-off-by: Georg Pfuetzenreuter --- shellcheck.1.md | 5 +++++ shellcheck.hs | 39 +++++++++++++++++++++++++++------------ 2 files changed, 32 insertions(+), 12 deletions(-) diff --git a/shellcheck.1.md b/shellcheck.1.md index 89f6d50..42a0429 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -71,6 +71,11 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts. : Don't try to look for .shellcheckrc configuration files. +--rcfile\ RCFILE + +: Prefer the specified configuration file over searching for one + in the default locations. + **-o**\ *NAME1*[,*NAME2*...],\ **--enable=***NAME1*[,*NAME2*...] : Enable optional checks. The special name *all* enables all of them. diff --git a/shellcheck.hs b/shellcheck.hs index 00b699b..42554f3 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -76,7 +76,8 @@ data Options = Options { externalSources :: Bool, sourcePaths :: [FilePath], formatterOptions :: FormatterOptions, - minSeverity :: Severity + minSeverity :: Severity, + rcfile :: FilePath } defaultOptions = Options { @@ -86,7 +87,8 @@ defaultOptions = Options { formatterOptions = newFormatterOptions { foColorOption = ColorAuto }, - minSeverity = StyleC + minSeverity = StyleC, + rcfile = [] } usageHeader = "Usage: shellcheck [OPTIONS...] FILES..." @@ -107,6 +109,9 @@ options = [ (NoArg $ Flag "list-optional" "true") "List checks disabled by default", Option "" ["norc"] (NoArg $ Flag "norc" "true") "Don't look for .shellcheckrc files", + Option "" ["rcfile"] + (ReqArg (Flag "rcfile") "RCFILE") + "Prefer the specified configuration file over searching for one", Option "o" ["enable"] (ReqArg (Flag "enable") "check1,check2..") "List of optional checks to enable (or 'all')", @@ -367,6 +372,11 @@ parseOption flag options = } } + Flag "rcfile" str -> do + return options { + rcfile = str + } + Flag "enable" value -> let cs = checkSpec options in return options { checkSpec = cs { @@ -441,18 +451,23 @@ ioInterface options files = do fallback :: FilePath -> IOException -> IO FilePath fallback path _ = return path + -- Returns the name and contents of .shellcheckrc for the given file getConfig cache filename = do - path <- normalize filename - let dir = takeDirectory path - (previousPath, result) <- readIORef cache - if dir == previousPath - then return result - else do - paths <- getConfigPaths dir - result <- findConfig paths - writeIORef cache (dir, result) - return result + contents <- readConfig (rcfile options) + if isNothing contents + then do + path <- normalize filename + let dir = takeDirectory path + (previousPath, result) <- readIORef cache + if dir == previousPath + then return result + else do + paths <- getConfigPaths dir + result <- findConfig paths + writeIORef cache (dir, result) + return result + else return contents findConfig paths = case paths of From de95624d310622d234149e5b1bc96da2a40ff317 Mon Sep 17 00:00:00 2001 From: Grische <2787581+grische@users.noreply.github.com> Date: Fri, 2 Feb 2024 12:28:09 +0100 Subject: [PATCH 162/244] Remove deprecated "install --enable-tests" command --- README.md | 5 ----- 1 file changed, 5 deletions(-) diff --git a/README.md b/README.md index ca9b847..3692319 100644 --- a/README.md +++ b/README.md @@ -309,10 +309,6 @@ Verify that `cabal` is installed and update its dependency list with $ cabal install -Or if you intend to run the tests: - - $ cabal install --enable-tests - This will compile ShellCheck and install it to your `~/.cabal/bin` directory. Add this directory to your `PATH` (for bash, add this to your `~/.bashrc`): @@ -558,4 +554,3 @@ Happy ShellChecking! * The wiki has [long form descriptions](https://github.com/koalaman/shellcheck/wiki/Checks) for each warning, e.g. [SC2221](https://github.com/koalaman/shellcheck/wiki/SC2221). * ShellCheck does not attempt to enforce any kind of formatting or indenting style, so also check out [shfmt](https://github.com/mvdan/sh)! - From 6a44a19f17c4a0590693587af3b5209d7b1b59fe Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 3 Feb 2024 13:34:49 -0800 Subject: [PATCH 163/244] Only read --rcfile once, and skip search if unavailable --- shellcheck.hs | 48 +++++++++++++++++++++++++++++------------------- 1 file changed, 29 insertions(+), 19 deletions(-) diff --git a/shellcheck.hs b/shellcheck.hs index 42554f3..e933d6c 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -77,7 +77,7 @@ data Options = Options { sourcePaths :: [FilePath], formatterOptions :: FormatterOptions, minSeverity :: Severity, - rcfile :: FilePath + rcfile :: Maybe FilePath } defaultOptions = Options { @@ -88,7 +88,7 @@ defaultOptions = Options { foColorOption = ColorAuto }, minSeverity = StyleC, - rcfile = [] + rcfile = Nothing } usageHeader = "Usage: shellcheck [OPTIONS...] FILES..." @@ -374,7 +374,7 @@ parseOption flag options = Flag "rcfile" str -> do return options { - rcfile = str + rcfile = Just str } Flag "enable" value -> @@ -453,21 +453,31 @@ ioInterface options files = do -- Returns the name and contents of .shellcheckrc for the given file - getConfig cache filename = do - contents <- readConfig (rcfile options) - if isNothing contents - then do - path <- normalize filename - let dir = takeDirectory path - (previousPath, result) <- readIORef cache - if dir == previousPath - then return result - else do - paths <- getConfigPaths dir - result <- findConfig paths - writeIORef cache (dir, result) - return result - else return contents + getConfig cache filename = + case rcfile options of + Just file -> do + -- We have a specified rcfile. Ignore normal rcfile resolution. + (path, result) <- readIORef cache + if path == "/" + then return result + else do + result <- readConfig file + when (isNothing result) $ + hPutStrLn stderr $ "Warning: unable to read --rcfile " ++ file + writeIORef cache ("/", result) + return result + + Nothing -> do + path <- normalize filename + let dir = takeDirectory path + (previousPath, result) <- readIORef cache + if dir == previousPath + then return result + else do + paths <- getConfigPaths dir + result <- findConfig paths + writeIORef cache (dir, result) + return result findConfig paths = case paths of @@ -505,7 +515,7 @@ ioInterface options files = do where handler :: FilePath -> IOException -> IO (String, Bool) handler file err = do - putStrLn $ file ++ ": " ++ show err + hPutStrLn stderr $ file ++ ": " ++ show err return ("", True) andM a b arg = do From d80fdfa9e8e738827a88505b26d3e596c0f0e875 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 3 Feb 2024 15:45:23 -0800 Subject: [PATCH 164/244] Add extended-analysis directive to toggle DFA --- CHANGELOG.md | 5 +++- shellcheck.1.md | 13 +++++++++ shellcheck.hs | 18 +++++++++++++ src/ShellCheck/AST.hs | 1 + src/ShellCheck/ASTLib.hs | 6 +++++ src/ShellCheck/Analytics.hs | 21 +++++++++------ src/ShellCheck/AnalyzerLib.hs | 8 ++++-- src/ShellCheck/Checker.hs | 40 ++++++++++++++++++++++++++++ src/ShellCheck/Checks/Commands.hs | 18 +++++++------ src/ShellCheck/Checks/ControlFlow.hs | 2 +- src/ShellCheck/Interface.hs | 8 ++++-- src/ShellCheck/Parser.hs | 10 +++++++ 12 files changed, 128 insertions(+), 22 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 897aa27..dc7f6ea 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ ## Git ### Added +- Added support for busybox sh +- Added flag --rcfile to specify an rc file by name. +- Added `extended-analysis=true` directive to enable/disable dataflow analysis + (with a corresponding --extended-analysis flag). - SC2324: Warn when x+=1 appends instead of increments - SC2325: Warn about multiple `!`s in dash/sh. - SC2326: Warn about `foo | ! bar` in bash/dash/sh. @@ -9,7 +13,6 @@ - SC3015: Warn bashism `test _ =~ _` like in [ ] - SC3016: Warn bashism `test -v _` like in [ ] - SC3017: Warn bashism `test -a _` like in [ ] -- Added support for busybox sh ### Fixed - source statements with here docs now work correctly diff --git a/shellcheck.1.md b/shellcheck.1.md index 42a0429..b2bef3c 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -56,6 +56,13 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts. options are cumulative, but all the codes can be specified at once, comma-separated as a single argument. +**--extended-analysis=true/false** + +: Enable/disable Dataflow Analysis to identify more issues (default true). If + ShellCheck uses too much CPU/RAM when checking scripts with several + thousand lines of code, extended analysis can be disabled with this flag + or a directive. This flag overrides directives and rc files. + **-f** *FORMAT*, **--format=***FORMAT* : Specify the output format of shellcheck, which prints its results in the @@ -249,6 +256,12 @@ Valid keys are: : Enable an optional check by name, as listed with **--list-optional**. Only file-wide `enable` directives are considered. +**extended-analysis** +: Set to true/false to enable/disable dataflow analysis. Specifying + `# shellcheck extended-analysis=false` in particularly large (2000+ line) + auto-generated scripts will reduce ShellCheck's resource usage at the + expense of certain checks. Extended analysis is enabled by default. + **external-sources** : Set to `true` in `.shellcheckrc` to always allow ShellCheck to open arbitrary files from 'source' statements (the way most tools do). diff --git a/shellcheck.hs b/shellcheck.hs index e933d6c..def3654 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -102,6 +102,8 @@ options = [ (ReqArg (Flag "include") "CODE1,CODE2..") "Consider only given types of warnings", Option "e" ["exclude"] (ReqArg (Flag "exclude") "CODE1,CODE2..") "Exclude types of warnings", + Option "" ["extended-analysis"] + (ReqArg (Flag "extended-analysis") "bool") "Perform dataflow analysis (default true)", Option "f" ["format"] (ReqArg (Flag "format") "FORMAT") $ "Output format (" ++ formatList ++ ")", @@ -384,6 +386,14 @@ parseOption flag options = } } + Flag "extended-analysis" str -> do + value <- parseBool str + return options { + checkSpec = (checkSpec options) { + csExtendedAnalysis = Just value + } + } + -- This flag is handled specially in 'process' Flag "format" _ -> return options @@ -401,6 +411,14 @@ parseOption flag options = throwError SyntaxFailure return (Prelude.read num :: Integer) + parseBool str = do + case str of + "true" -> return True + "false" -> return False + _ -> do + printErr $ "Invalid boolean, expected true/false: " ++ str + throwError SyntaxFailure + ioInterface :: Options -> [FilePath] -> IO (SystemInterface IO) ioInterface options files = do inputs <- mapM normalize files diff --git a/src/ShellCheck/AST.hs b/src/ShellCheck/AST.hs index 5c20416..ca05c98 100644 --- a/src/ShellCheck/AST.hs +++ b/src/ShellCheck/AST.hs @@ -152,6 +152,7 @@ data Annotation = | ShellOverride String | SourcePath String | ExternalSources Bool + | ExtendedAnalysis Bool deriving (Show, Eq) data ConditionType = DoubleBracket | SingleBracket deriving (Show, Eq) diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 88089ea..6b26b22 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -910,5 +910,11 @@ getEnableDirectives root = T_Annotation _ list _ -> [s | EnableComment s <- list] _ -> [] +getExtendedAnalysisDirective :: Token -> Maybe Bool +getExtendedAnalysisDirective root = + case root of + T_Annotation _ list _ -> listToMaybe $ [s | ExtendedAnalysis s <- list] + _ -> Nothing + return [] runTests = $quickCheckAll diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 3af0455..f885842 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1262,7 +1262,8 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do str = concat $ oversimplify c var = getBracedReference str in fromMaybe False $ do - state <- CF.getIncomingState (cfgAnalysis params) id + cfga <- cfgAnalysis params + state <- CF.getIncomingState cfga id value <- Map.lookup var $ CF.variablesInScope state return $ CF.numericalStatus (CF.variableValue value) >= CF.NumericalStatusMaybe _ -> @@ -2143,7 +2144,8 @@ checkSpacefulnessCfg' dirtyPass params token@(T_DollarBraced id _ list) = && not (usedAsCommandName parents token) isClean = fromMaybe False $ do - state <- CF.getIncomingState (cfgAnalysis params) id + cfga <- cfgAnalysis params + state <- CF.getIncomingState cfga id value <- Map.lookup name $ CF.variablesInScope state return $ isCleanState value @@ -4896,7 +4898,8 @@ prop_checkCommandIsUnreachable3 = verifyNot checkCommandIsUnreachable "foo; bar checkCommandIsUnreachable params t = case t of T_Pipeline {} -> sequence_ $ do - state <- CF.getIncomingState (cfgAnalysis params) id + cfga <- cfgAnalysis params + state <- CF.getIncomingState cfga id guard . not $ CF.stateIsReachable state guard . not $ isSourced params t return $ info id 2317 "Command appears to be unreachable. Check usage (or ignore if invoked indirectly)." @@ -4918,14 +4921,15 @@ checkOverwrittenExitCode params t = _ -> return () where check id = sequence_ $ do - state <- CF.getIncomingState (cfgAnalysis params) id + cfga <- cfgAnalysis params + state <- CF.getIncomingState cfga id let exitCodeIds = CF.exitCodes state guard . not $ S.null exitCodeIds let idToToken = idMap params exitCodeTokens <- traverse (\k -> Map.lookup k idToToken) $ S.toList exitCodeIds return $ do - when (all isCondition exitCodeTokens && not (usedUnconditionally t exitCodeIds)) $ + when (all isCondition exitCodeTokens && not (usedUnconditionally cfga t exitCodeIds)) $ warn id 2319 "This $? refers to a condition, not a command. Assign to a variable to avoid it being overwritten." when (all isPrinting exitCodeTokens) $ warn id 2320 "This $? refers to echo/printf, not a previous command. Assign to variable to avoid it being overwritten." @@ -4938,8 +4942,8 @@ checkOverwrittenExitCode params t = -- If we don't do anything based on the condition, assume we wanted the condition itself -- This helps differentiate `x; [ $? -gt 0 ] && exit $?` vs `[ cond ]; exit $?` - usedUnconditionally t testIds = - all (\c -> CF.doesPostDominate (cfgAnalysis params) (getId t) c) testIds + usedUnconditionally cfga t testIds = + all (\c -> CF.doesPostDominate cfga (getId t) c) testIds isPrinting t = case getCommandBasename t of @@ -5009,7 +5013,8 @@ prop_checkPlusEqualsNumber9 = verifyNot checkPlusEqualsNumber "declare -ia var; checkPlusEqualsNumber params t = case t of T_Assignment id Append var _ word -> sequence_ $ do - state <- CF.getIncomingState (cfgAnalysis params) id + cfga <- cfgAnalysis params + state <- CF.getIncomingState cfga id guard $ isNumber state word guard . not $ fromMaybe False $ CF.variableMayBeDeclaredInteger state var return $ warn id 2324 "var+=1 will append, not increment. Use (( var += 1 )), declare -i var, or quote number to silence." diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 944b12d..d265ace 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -104,7 +104,7 @@ data Parameters = Parameters { -- map from token id to start and end position tokenPositions :: Map.Map Id (Position, Position), -- Result from Control Flow Graph analysis (including data flow analysis) - cfgAnalysis :: CF.CFGAnalysis + cfgAnalysis :: Maybe CF.CFGAnalysis } deriving (Show) -- TODO: Cache results of common AST ops here @@ -197,8 +197,10 @@ makeCommentWithFix severity id code str fix = } in force withFix +-- makeParameters :: CheckSpec -> Parameters makeParameters spec = params where + extendedAnalysis = fromMaybe True $ msum [asExtendedAnalysis spec, getExtendedAnalysisDirective root] params = Parameters { rootNode = root, shellType = fromMaybe (determineShell (asFallbackShell spec) root) $ asShellType spec, @@ -229,7 +231,9 @@ makeParameters spec = params parentMap = getParentTree root, variableFlow = getVariableFlow params root, tokenPositions = asTokenPositions spec, - cfgAnalysis = CF.analyzeControlFlow cfParams root + cfgAnalysis = do + guard extendedAnalysis + return $ CF.analyzeControlFlow cfParams root } cfParams = CF.CFGParameters { CF.cfLastpipe = hasLastpipe params, diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index 6c9166f..0cfc3ab 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -25,6 +25,7 @@ import ShellCheck.ASTLib import ShellCheck.Interface import ShellCheck.Parser +import Debug.Trace -- DO NOT SUBMIT import Data.Either import Data.Functor import Data.List @@ -86,6 +87,7 @@ checkScript sys spec = do asCheckSourced = csCheckSourced spec, asExecutionMode = Executed, asTokenPositions = tokenPositions, + asExtendedAnalysis = csExtendedAnalysis spec, asOptionalChecks = getEnableDirectives root ++ csOptionalChecks spec } where as = newAnalysisSpec root let analysisMessages = @@ -520,5 +522,43 @@ prop_hereDocsWillHaveParsedIndices = null result where result = check "#!/bin/bash\nmy_array=(a b)\ncat <> ./test\n $(( 1 + my_array[1] ))\nEOF" +prop_rcCanSuppressDfa = null result + where + result = checkWithRc "extended-analysis=false" emptyCheckSpec { + csScript = "#!/bin/sh\nexit; foo;" + } + +prop_fileCanSuppressDfa = null $ traceShowId result + where + result = checkWithRc "" emptyCheckSpec { + csScript = "#!/bin/sh\n# shellcheck extended-analysis=false\nexit; foo;" + } + +prop_fileWinsWhenSuppressingDfa1 = null result + where + result = checkWithRc "extended-analysis=true" emptyCheckSpec { + csScript = "#!/bin/sh\n# shellcheck extended-analysis=false\nexit; foo;" + } + +prop_fileWinsWhenSuppressingDfa2 = result == [2317] + where + result = checkWithRc "extended-analysis=false" emptyCheckSpec { + csScript = "#!/bin/sh\n# shellcheck extended-analysis=true\nexit; foo;" + } + +prop_flagWinsWhenSuppressingDfa1 = result == [2317] + where + result = checkWithRc "extended-analysis=false" emptyCheckSpec { + csScript = "#!/bin/sh\n# shellcheck extended-analysis=false\nexit; foo;", + csExtendedAnalysis = Just True + } + +prop_flagWinsWhenSuppressingDfa2 = null result + where + result = checkWithRc "extended-analysis=true" emptyCheckSpec { + csScript = "#!/bin/sh\n# shellcheck extended-analysis=true\nexit; foo;", + csExtendedAnalysis = Just False + } + return [] runTests = $quickCheckAll diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 97c9088..c10016e 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -1430,26 +1430,28 @@ prop_checkBackreferencingDeclaration6 = verify (checkBackreferencingDeclaration prop_checkBackreferencingDeclaration7 = verify (checkBackreferencingDeclaration "declare") "declare x=var $k=$x" checkBackreferencingDeclaration cmd = CommandCheck (Exactly cmd) check where - check t = foldM_ perArg M.empty $ arguments t + check t = do + cfga <- asks cfgAnalysis + when (isJust cfga) $ + foldM_ (perArg $ fromJust cfga) M.empty $ arguments t - perArg leftArgs t = + perArg cfga leftArgs t = case t of T_Assignment id _ name idx t -> do - warnIfBackreferencing leftArgs $ t:idx + warnIfBackreferencing cfga leftArgs $ t:idx return $ M.insert name id leftArgs t -> do - warnIfBackreferencing leftArgs [t] + warnIfBackreferencing cfga leftArgs [t] return leftArgs - warnIfBackreferencing backrefs l = do - references <- findReferences l + warnIfBackreferencing cfga backrefs l = do + references <- findReferences cfga l let reused = M.intersection backrefs references mapM msg $ M.toList reused msg (name, id) = warn id 2318 $ "This assignment is used again in this '" ++ cmd ++ "', but won't have taken effect. Use two '" ++ cmd ++ "'s." - findReferences list = do - cfga <- asks cfgAnalysis + findReferences cfga list = do let graph = CF.graph cfga let nodesMap = CF.tokenToNodes cfga let nodes = S.unions $ map (\id -> M.findWithDefault S.empty id nodesMap) $ map getId $ list diff --git a/src/ShellCheck/Checks/ControlFlow.hs b/src/ShellCheck/Checks/ControlFlow.hs index 9b7635e..d23fa15 100644 --- a/src/ShellCheck/Checks/ControlFlow.hs +++ b/src/ShellCheck/Checks/ControlFlow.hs @@ -78,7 +78,7 @@ controlFlowEffectChecks = [ runNodeChecks :: [ControlFlowNodeCheck] -> ControlFlowCheck runNodeChecks perNode = do cfg <- asks cfgAnalysis - runOnAll cfg + sequence_ $ runOnAll <$> cfg where getData datas n@(node, label) = do (pre, post) <- M.lookup node datas diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index c574cee..04e3c5a 100644 --- a/src/ShellCheck/Interface.hs +++ b/src/ShellCheck/Interface.hs @@ -21,11 +21,11 @@ module ShellCheck.Interface ( SystemInterface(..) - , CheckSpec(csFilename, csScript, csCheckSourced, csIncludedWarnings, csExcludedWarnings, csShellTypeOverride, csMinSeverity, csIgnoreRC, csOptionalChecks) + , CheckSpec(csFilename, csScript, csCheckSourced, csIncludedWarnings, csExcludedWarnings, csShellTypeOverride, csMinSeverity, csIgnoreRC, csExtendedAnalysis, csOptionalChecks) , CheckResult(crFilename, crComments) , ParseSpec(psFilename, psScript, psCheckSourced, psIgnoreRC, psShellTypeOverride) , ParseResult(prComments, prTokenPositions, prRoot) - , AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asOptionalChecks) + , AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asExtendedAnalysis, asOptionalChecks) , AnalysisResult(arComments) , FormatterOptions(foColorOption, foWikiLinkCount) , Shell(Ksh, Sh, Bash, Dash, BusyboxSh) @@ -100,6 +100,7 @@ data CheckSpec = CheckSpec { csIncludedWarnings :: Maybe [Integer], csShellTypeOverride :: Maybe Shell, csMinSeverity :: Severity, + csExtendedAnalysis :: Maybe Bool, csOptionalChecks :: [String] } deriving (Show, Eq) @@ -124,6 +125,7 @@ emptyCheckSpec = CheckSpec { csIncludedWarnings = Nothing, csShellTypeOverride = Nothing, csMinSeverity = StyleC, + csExtendedAnalysis = Nothing, csOptionalChecks = [] } @@ -174,6 +176,7 @@ data AnalysisSpec = AnalysisSpec { asExecutionMode :: ExecutionMode, asCheckSourced :: Bool, asOptionalChecks :: [String], + asExtendedAnalysis :: Maybe Bool, asTokenPositions :: Map.Map Id (Position, Position) } @@ -184,6 +187,7 @@ newAnalysisSpec token = AnalysisSpec { asExecutionMode = Executed, asCheckSourced = False, asOptionalChecks = [], + asExtendedAnalysis = Nothing, asTokenPositions = Map.empty } diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 130d956..9cc5e02 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -1058,6 +1058,16 @@ readAnnotationWithoutPrefix sandboxed = do "This shell type is unknown. Use e.g. sh or bash." return [ShellOverride shell] + "extended-analysis" -> do + pos <- getPosition + value <- plainOrQuoted $ many1 letter + case value of + "true" -> return [ExtendedAnalysis True] + "false" -> return [ExtendedAnalysis False] + _ -> do + parseNoteAt pos ErrorC 1146 "Unknown extended-analysis value. Expected true/false." + return [] + "external-sources" -> do pos <- getPosition value <- plainOrQuoted $ many1 letter From 8c4c112c2504b630b5e58a87c8f42bbe9c955946 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 19 Feb 2024 09:28:04 -0800 Subject: [PATCH 165/244] Initial version of an ARM64 macOS build --- .github/workflows/build.yml | 2 +- build/darwin.aarch64/Dockerfile | 40 +++++++++++++++++++++++++++++++++ build/darwin.aarch64/build | 15 +++++++++++++ build/darwin.aarch64/tag | 1 + 4 files changed, 57 insertions(+), 1 deletion(-) create mode 100644 build/darwin.aarch64/Dockerfile create mode 100755 build/darwin.aarch64/build create mode 100644 build/darwin.aarch64/tag diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 3e6fb27..c49b25a 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -47,7 +47,7 @@ jobs: needs: package_source strategy: matrix: - build: [linux.x86_64, linux.aarch64, linux.armv6hf, darwin.x86_64, windows.x86_64] + build: [linux.x86_64, linux.aarch64, linux.armv6hf, darwin.x86_64, darwin.aarch64, windows.x86_64] runs-on: ubuntu-latest steps: - name: Checkout repository diff --git a/build/darwin.aarch64/Dockerfile b/build/darwin.aarch64/Dockerfile new file mode 100644 index 0000000..7839728 --- /dev/null +++ b/build/darwin.aarch64/Dockerfile @@ -0,0 +1,40 @@ +FROM ghcr.io/shepherdjerred/macos-cross-compiler:latest + +ENV TARGET aarch64-apple-darwin22 +ENV TARGETNAME darwin.aarch64 + +# Build dependencies +USER root +ENV DEBIAN_FRONTEND noninteractive +ENV LC_ALL C.utf8 + +# Install basic deps +RUN apt-get update && apt-get install -y automake autoconf build-essential curl xz-utils qemu-user-static + +# Install a more suitable host compiler +WORKDIR /host-ghc +RUN curl -L "https://downloads.haskell.org/~cabal/cabal-install-3.9.0.0/cabal-install-3.9-x86_64-linux-alpine.tar.xz" | tar xJv -C /usr/local/bin +RUN curl -L 'https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-x86_64-deb10-linux.tar.xz' | tar xJ --strip-components=1 +RUN ./configure && make install + +# Build GHC. We have to use an old version because cross-compilation across OS has since broken. +WORKDIR /ghc +RUN curl -L "https://downloads.haskell.org/~ghc/8.10.7/ghc-8.10.7-src.tar.xz" | tar xJ --strip-components=1 +RUN apt-get install -y llvm-12 +RUN ./boot && ./configure --host x86_64-linux-gnu --build x86_64-linux-gnu --target "$TARGET" +RUN cp mk/flavours/quick-cross.mk mk/build.mk && make -j "$(nproc)" +RUN make install + +# Due to an apparent cabal bug, we specify our options directly to cabal +# It won't reuse caches if ghc-options are specified in ~/.cabal/config +ENV CABALOPTS "--ghc-options;-optc-Os -optc-fPIC;--with-ghc=$TARGET-ghc;--with-hc-pkg=$TARGET-ghc-pkg;--constraint=hashable==1.3.5.0" + +# Prebuild the dependencies +RUN cabal update +RUN IFS=';' && cabal install --dependencies-only $CABALOPTS ShellCheck + +# Copy the build script +COPY build /usr/bin + +WORKDIR /scratch +ENTRYPOINT ["/usr/bin/build"] diff --git a/build/darwin.aarch64/build b/build/darwin.aarch64/build new file mode 100755 index 0000000..c15717a --- /dev/null +++ b/build/darwin.aarch64/build @@ -0,0 +1,15 @@ +#!/bin/sh +set -xe +{ + tar xzv --strip-components=1 + chmod +x striptests && ./striptests + mkdir "$TARGETNAME" + cabal update + ( IFS=';'; cabal build $CABALOPTS ) + find . -name shellcheck -type f -exec mv {} "$TARGETNAME/" \; + ls -l "$TARGETNAME" + "$TARGET-strip" "$TARGETNAME/shellcheck" + ls -l "$TARGETNAME" + file "$TARGETNAME/shellcheck" | grep "Mach-O 64-bit arm64 executable" +} >&2 +tar czv "$TARGETNAME" diff --git a/build/darwin.aarch64/tag b/build/darwin.aarch64/tag new file mode 100644 index 0000000..ae93ef3 --- /dev/null +++ b/build/darwin.aarch64/tag @@ -0,0 +1 @@ +koalaman/scbuilder-darwin-aarch64 From 55be4543f225824e1f6534973ad51c7833343e4e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 19 Feb 2024 11:40:30 -0800 Subject: [PATCH 166/244] Avoid stripping darwin.aarch64 binaries to keep code signature --- build/darwin.aarch64/build | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/build/darwin.aarch64/build b/build/darwin.aarch64/build index c15717a..4235d3a 100755 --- a/build/darwin.aarch64/build +++ b/build/darwin.aarch64/build @@ -8,7 +8,9 @@ set -xe ( IFS=';'; cabal build $CABALOPTS ) find . -name shellcheck -type f -exec mv {} "$TARGETNAME/" \; ls -l "$TARGETNAME" - "$TARGET-strip" "$TARGETNAME/shellcheck" + # Stripping invalidates the code signature and the build image does + # not appear to have anything similar to the 'codesign' tool. + # "$TARGET-strip" "$TARGETNAME/shellcheck" ls -l "$TARGETNAME" file "$TARGETNAME/shellcheck" | grep "Mach-O 64-bit arm64 executable" } >&2 From ad3c3146f0e10fcd331a1c8bba29e710f4417c99 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 3 Mar 2024 12:34:29 -0800 Subject: [PATCH 167/244] Fix snap build --- .snapsquid.conf | 14 -------------- snap/snapcraft.yaml | 18 +++++++++--------- 2 files changed, 9 insertions(+), 23 deletions(-) delete mode 100644 .snapsquid.conf diff --git a/.snapsquid.conf b/.snapsquid.conf deleted file mode 100644 index 205c1a6..0000000 --- a/.snapsquid.conf +++ /dev/null @@ -1,14 +0,0 @@ -# In 2015, cabal-install had a http bug triggered when proxies didn't keep -# the connection open. This version made it into Ubuntu Xenial as used by -# Snapcraft. In June 2018, Snapcraft's proxy started triggering this bug. -# -# https://bugs.launchpad.net/launchpad-buildd/+bug/1797809 -# -# Workaround: add more proxy - -visible_hostname localhost -http_port 8888 -cache_peer 10.10.10.1 parent 8222 0 no-query default -cache_peer_domain localhost !.internal -http_access allow all - diff --git a/snap/snapcraft.yaml b/snap/snapcraft.yaml index e14b854..f294c4e 100644 --- a/snap/snapcraft.yaml +++ b/snap/snapcraft.yaml @@ -23,7 +23,7 @@ description: | # snap connect shellcheck:removable-media version: git -base: core18 +base: core20 grade: stable confinement: strict @@ -40,16 +40,16 @@ parts: source: . build-packages: - cabal-install - - squid + stage-packages: + - libatomic1 override-build: | - # See comments in .snapsquid.conf - [ "$http_proxy" ] && { - squid3 -f .snapsquid.conf - export http_proxy="http://localhost:8888" - sleep 3 - } + # Give ourselves enough memory to build + dd if=/dev/zero of=/tmp/swap bs=1M count=2000 + mkswap /tmp/swap + swapon /tmp/swap + cabal sandbox init - cabal update || cat /var/log/squid/* + cabal update cabal install -j install -d $SNAPCRAFT_PART_INSTALL/usr/bin From 8bc7345aa7ec55f79a433388f443dddf4e89e270 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 3 Mar 2024 16:11:44 -0800 Subject: [PATCH 168/244] Remove outdated distros from testing --- test/distrotest | 2 -- 1 file changed, 2 deletions(-) diff --git a/test/distrotest b/test/distrotest index 4ad66f8..ef467b8 100755 --- a/test/distrotest +++ b/test/distrotest @@ -76,8 +76,6 @@ archlinux:latest pacman -S -y --noconfirm cabal-install ghc-static base-dev # Ubuntu LTS ubuntu:22.04 apt-get update && apt-get install -y cabal-install ubuntu:20.04 apt-get update && apt-get install -y cabal-install -ubuntu:18.04 apt-get update && apt-get install -y cabal-install -ubuntu:16.04 apt-get update && apt-get install -y cabal-install # Stack on Ubuntu LTS ubuntu:22.04 set -e; apt-get update && apt-get install -y curl && curl -sSL https://get.haskellstack.org/ | sh -s - -f && cd /mnt && exec test/stacktest From a7e65dca8d7b0d19db9808e9ae17e2aa86ddbba4 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 4 Mar 2024 09:19:51 -0800 Subject: [PATCH 169/244] Update some copyright years --- shellcheck.1.md | 2 +- src/ShellCheck/Analytics.hs | 2 +- src/ShellCheck/Interface.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/shellcheck.1.md b/shellcheck.1.md index b2bef3c..b873e45 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -397,7 +397,7 @@ long list of wonderful contributors. # COPYRIGHT -Copyright 2012-2022, Vidar Holen and contributors. +Copyright 2012-2024, Vidar Holen and contributors. Licensed under the GNU General Public License version 3 or later, see https://gnu.org/licenses/gpl.html diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index f885842..1cc8bf8 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1,5 +1,5 @@ {- - Copyright 2012-2022 Vidar Holen + Copyright 2012-2024 Vidar Holen This file is part of ShellCheck. https://www.shellcheck.net diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index 04e3c5a..16a7e36 100644 --- a/src/ShellCheck/Interface.hs +++ b/src/ShellCheck/Interface.hs @@ -1,5 +1,5 @@ {- - Copyright 2012-2019 Vidar Holen + Copyright 2012-2024 Vidar Holen This file is part of ShellCheck. https://www.shellcheck.net From 37dfb67768db726092fde482d338943d678e6988 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 7 Mar 2024 17:53:15 -0800 Subject: [PATCH 170/244] Stable version v0.10.0 This release is dedicated to LLMs, for finally fulfilling the promise of 1960s scifi: systems you can hack using logic games and creative lies. --- CHANGELOG.md | 6 +++--- ShellCheck.cabal | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index dc7f6ea..6c8beeb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,6 @@ -## Git +## v0.10.0 - 2024-03-07 ### Added +- Precompiled binaries for macOS ARM64 (darwin.aarch64) - Added support for busybox sh - Added flag --rcfile to specify an rc file by name. - Added `extended-analysis=true` directive to enable/disable dataflow analysis @@ -16,8 +17,7 @@ ### Fixed - source statements with here docs now work correctly - -### Changed +- "(Array.!): undefined array element" error should no longer occur ## v0.9.0 - 2022-12-12 diff --git a/ShellCheck.cabal b/ShellCheck.cabal index a12f75e..fc52b12 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -1,5 +1,5 @@ Name: ShellCheck -Version: 0.9.0 +Version: 0.10.0 Synopsis: Shell script analysis tool License: GPL-3 License-file: LICENSE From 94214ee725122b91374b1782e93ae239aff04762 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 7 Mar 2024 19:11:12 -0800 Subject: [PATCH 171/244] Post-release CHANGELOG --- CHANGELOG.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6c8beeb..b40245a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## Git +### Added +### Fixed + + ## v0.10.0 - 2024-03-07 ### Added - Precompiled binaries for macOS ARM64 (darwin.aarch64) From 50db9a29c45f1f2a0db7ec60c8850c99e8e31d6e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 7 Mar 2024 19:11:32 -0800 Subject: [PATCH 172/244] Check source details before git details --- test/check_release | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/test/check_release b/test/check_release index fd1dbca..4aef69a 100755 --- a/test/check_release +++ b/test/check_release @@ -12,6 +12,17 @@ then fail "There are uncommitted changes" fi +version=${current#v} +if ! grep "Version:" ShellCheck.cabal | grep -qFw "$version" +then + fail "The cabal file does not match tag version $version" +fi + +if ! grep -qF "## $current" CHANGELOG.md +then + fail "CHANGELOG.md does not contain '## $current'" +fi + current=$(git tag --points-at) if [[ -z "$current" ]] then @@ -34,17 +45,6 @@ then fail "You are not on master" fi -version=${current#v} -if ! grep "Version:" ShellCheck.cabal | grep -qFw "$version" -then - fail "The cabal file does not match tag version $version" -fi - -if ! grep -qF "## $current" CHANGELOG.md -then - fail "CHANGELOG.md does not contain '## $current'" -fi - if [[ $(git log -1 --pretty=%B) != "Stable version "* ]] then fail "Expected git log message to be 'Stable version ...'" From 9cb21c8557cb981e5f49da20af9335bb68f04dee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lawrence=20Vel=C3=A1zquez?= Date: Fri, 8 Mar 2024 18:24:08 -0500 Subject: [PATCH 173/244] Recommend `typeset` instead of `declare` in SC2324 Bash has both `typeset` and `declare`, but ksh has `typeset` only. Recommend the more portable alternative to users. --- src/ShellCheck/Analytics.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 1cc8bf8..f37ac1d 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -5017,7 +5017,8 @@ checkPlusEqualsNumber params t = state <- CF.getIncomingState cfga id guard $ isNumber state word guard . not $ fromMaybe False $ CF.variableMayBeDeclaredInteger state var - return $ warn id 2324 "var+=1 will append, not increment. Use (( var += 1 )), declare -i var, or quote number to silence." + -- Recommend "typeset" because ksh does not have "declare". + return $ warn id 2324 "var+=1 will append, not increment. Use (( var += 1 )), typeset -i var, or quote number to silence." _ -> return () where From 52dc66349b0882b0d6ac3d81a81f3eef0b155158 Mon Sep 17 00:00:00 2001 From: Joachim Ansorg Date: Tue, 12 Mar 2024 17:36:20 +0100 Subject: [PATCH 174/244] fix build of linux.aarch64 --- build/linux.aarch64/Dockerfile | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/build/linux.aarch64/Dockerfile b/build/linux.aarch64/Dockerfile index d5320e9..fadb6a4 100644 --- a/build/linux.aarch64/Dockerfile +++ b/build/linux.aarch64/Dockerfile @@ -12,11 +12,15 @@ RUN apt-get update && apt-get install -y llvm gcc-$TARGET # The rest are from 22.10 RUN sed -e 's/focal/kinetic/g' -i /etc/apt/sources.list +# Kinetic does not receive updates anymore, switch to last available +RUN sed -e 's/archive.ubuntu.com/old-releases.ubuntu.com/g' -i /etc/apt/sources.list +RUN sed -e 's/security.ubuntu.com/old-releases.ubuntu.com/g' -i /etc/apt/sources.list + RUN apt-get update && apt-get install -y ghc alex happy automake autoconf build-essential curl qemu-user-static # Build GHC WORKDIR /ghc -RUN curl -L "https://downloads.haskell.org/~ghc/9.2.5/ghc-9.2.5-src.tar.xz" | tar xJ --strip-components=1 +RUN curl -L "https://downloads.haskell.org/~ghc/9.2.8/ghc-9.2.8-src.tar.xz" | tar xJ --strip-components=1 RUN ./boot && ./configure --host x86_64-linux-gnu --build x86_64-linux-gnu --target "$TARGET" RUN cp mk/flavours/quick-cross.mk mk/build.mk && make -j "$(nproc)" RUN make install From c4123375e04931b3d0deb08728490687bc2fb3fd Mon Sep 17 00:00:00 2001 From: Joachim Ansorg Date: Tue, 12 Mar 2024 18:00:36 +0100 Subject: [PATCH 175/244] build smaller ShellCheck binary for Linux x86_64 --- build/linux.x86_64/Dockerfile | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/build/linux.x86_64/Dockerfile b/build/linux.x86_64/Dockerfile index 3112ac2..edafb36 100644 --- a/build/linux.x86_64/Dockerfile +++ b/build/linux.x86_64/Dockerfile @@ -1,4 +1,8 @@ -FROM alpine:latest +FROM alpine:3.16 +# alpine:3.16 (GHC 9.0.1): 5.8 megabytes +# alpine:3.17 (GHC 9.0.2): 15.0 megabytes +# alpine:3.18 (GHC 9.4.4): 29.0 megabytes +# alpine:3.19 (GHC 9.4.7): 29.0 megabytes ENV TARGETNAME linux.x86_64 From 0a7bb1822e9c80dae21aa6aaba6d8da3de5d9e94 Mon Sep 17 00:00:00 2001 From: Hugo Sousa <55895340+hugos99@users.noreply.github.com> Date: Thu, 4 Apr 2024 12:26:20 +0100 Subject: [PATCH 176/244] Update README.md to add macOS Arm64 pre-compiled binaries link --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index 6542ac2..366c427 100644 --- a/README.md +++ b/README.md @@ -233,6 +233,7 @@ Alternatively, you can download pre-compiled binaries for the latest release her * [Linux, x86_64](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.linux.x86_64.tar.xz) (statically linked) * [Linux, armv6hf](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.linux.armv6hf.tar.xz), i.e. Raspberry Pi (statically linked) * [Linux, aarch64](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.linux.aarch64.tar.xz) aka ARM64 (statically linked) +* [macOS, aarch64](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.darwin.aarch64.tar.xz) * [macOS, x86_64](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.darwin.x86_64.tar.xz) * [Windows, x86](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.zip) From 30b32af873c8b9e24731a5cb08bb20b7f148fa2d Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 4 Apr 2024 19:50:08 -0700 Subject: [PATCH 177/244] Add updating build images to release checks --- test/check_release | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/test/check_release b/test/check_release index 4aef69a..665b265 100755 --- a/test/check_release +++ b/test/check_release @@ -56,11 +56,14 @@ cat << EOF Manual Checklist $((i++)). Make sure none of the automated checks above failed +$((i++)). Run \`build/build_builder build/*/\` to update all builder images. +$((j++)). \`build/run_builder dist-newstyle/sdist/ShellCheck-*.tar.gz build/*/\` to verify that they work. +$((j++)). \`for f in \$(cat build/*/tag); do docker push "\$f"; done\` to upload them. +$((i++)). Run test/distrotest to ensure that most distros can build OOTB. $((i++)). Make sure GitHub Build currently passes: https://github.com/koalaman/shellcheck/actions $((i++)). Make sure SnapCraft build currently works: https://build.snapcraft.io/user/koalaman -$((i++)). Run test/distrotest to ensure that most distros can build OOTB. $((i++)). Format and read over the manual for bad formatting and outdated info. -$((i++)). Make sure the Hackage package builds. +$((i++)). Make sure the Hackage package builds locally. Release Steps From 5241878e5919d3581a8e0208c3d2345532dbb65f Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 5 Apr 2024 17:15:04 -0700 Subject: [PATCH 178/244] Update Windows build image with new cURL URL --- build/windows.x86_64/Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build/windows.x86_64/Dockerfile b/build/windows.x86_64/Dockerfile index 1e5c5d9..2ae78ac 100644 --- a/build/windows.x86_64/Dockerfile +++ b/build/windows.x86_64/Dockerfile @@ -12,7 +12,7 @@ WORKDIR /haskell RUN curl -L "https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-x86_64-unknown-mingw32.tar.xz" | tar xJ --strip-components=1 WORKDIR /haskell/bin RUN curl -L "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-unknown-mingw32.zip" | busybox unzip - -RUN curl -L "https://curl.se/windows/dl-7.84.0/curl-7.84.0-win64-mingw.zip" | busybox unzip - && mv curl-7.84.0-win64-mingw/bin/* . +RUN curl -L "https://curl.se/windows/dl-8.7.1_7/curl-8.7.1_7-win64-mingw.zip" | busybox unzip - && mv curl-*-win64-mingw/bin/* . ENV WINEPATH /haskell/bin # It's unknown whether Cabal on Windows suffers from the same issue From 04a86245a10fe0a9e48755237f315999986f54c0 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 8 Apr 2024 20:24:28 -0700 Subject: [PATCH 179/244] Remove trailing space in output (fixes #2961) --- src/ShellCheck/Formatter/TTY.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Formatter/TTY.hs b/src/ShellCheck/Formatter/TTY.hs index e503639..117da6e 100644 --- a/src/ShellCheck/Formatter/TTY.hs +++ b/src/ShellCheck/Formatter/TTY.hs @@ -169,7 +169,7 @@ showFixedString color comments lineNum fileLines = -- and/or other unrelated lines. let (excerptFix, excerpt) = sliceFile mergedFix fileLines -- in the spirit of error prone - putStrLn $ color "message" "Did you mean: " + putStrLn $ color "message" "Did you mean:" putStrLn $ unlines $ applyFix excerptFix excerpt cuteIndent :: PositionedComment -> String From 2c5155e43d030e1325c3c2765d8f492024b02fd9 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 14 Apr 2024 18:47:19 -0700 Subject: [PATCH 180/244] Warn about capturing the output of redirected commands. --- CHANGELOG.md | 1 + src/ShellCheck/Analytics.hs | 42 +++++++++++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index b40245a..25fc688 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,6 @@ ## Git ### Added +- SC2327/SC2328: Warn about capturing the output of redirected commands. ### Fixed diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index f37ac1d..8b74ac6 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -204,6 +204,7 @@ nodeChecks = [ ,checkUnnecessaryArithmeticExpansionIndex ,checkUnnecessaryParens ,checkPlusEqualsNumber + ,checkExpansionWithRedirection ] optionalChecks = map fst optionalTreeChecks @@ -5040,5 +5041,46 @@ checkPlusEqualsNumber params t = isUnquotedNumber || isNumericalVariableName || isNumericalVariableExpansion + +prop_checkExpansionWithRedirection1 = verify checkExpansionWithRedirection "var=$(foo > bar)" +prop_checkExpansionWithRedirection2 = verify checkExpansionWithRedirection "var=`foo 1> bar`" +prop_checkExpansionWithRedirection3 = verify checkExpansionWithRedirection "var=${ foo >> bar; }" +prop_checkExpansionWithRedirection4 = verify checkExpansionWithRedirection "var=$(foo | bar > baz)" +prop_checkExpansionWithRedirection5 = verifyNot checkExpansionWithRedirection "stderr=$(foo 2>&1 > /dev/null)" +prop_checkExpansionWithRedirection6 = verifyNot checkExpansionWithRedirection "var=$(foo; bar > baz)" +prop_checkExpansionWithRedirection7 = verifyNot checkExpansionWithRedirection "var=$(foo > bar; baz)" +prop_checkExpansionWithRedirection8 = verifyNot checkExpansionWithRedirection "var=$(cat <&3)" +checkExpansionWithRedirection params t = + case t of + T_DollarExpansion id [cmd] -> check id cmd + T_Backticked id [cmd] -> check id cmd + T_DollarBraceCommandExpansion id [cmd] -> check id cmd + _ -> return () + where + check id pipe = + case pipe of + (T_Pipeline _ _ t@(_:_)) -> checkCmd id (last t) + _ -> return () + + checkCmd captureId (T_Redirecting _ redirs _) = walk captureId redirs + + walk captureId [] = return () + walk captureId (t:rest) = + case t of + T_FdRedirect _ _ (T_IoDuplicate _ _ "1") -> return () + T_FdRedirect id "1" (T_IoDuplicate _ _ _) -> return () + T_FdRedirect id "" (T_IoDuplicate _ op _) | op `elem` [T_GREATAND (Id 0), T_Greater (Id 0)] -> emit id captureId True + T_FdRedirect id str (T_IoFile _ op file) | str `elem` ["", "1"] && op `elem` [ T_DGREAT (Id 0), T_Greater (Id 0) ] -> + if getLiteralString file == Just "/dev/null" + then emit id captureId False + else emit id captureId True + _ -> walk captureId rest + + emit redirectId captureId suggestTee = do + warn captureId 2327 "This command substitution will be empty because the command's output gets redirected away." + err redirectId 2328 $ "This redirection takes output away from the command substitution" ++ if suggestTee then " (use tee to duplicate)." else "." + + + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) From 69fe4e1306572fa639d92e80afe2639d6c12247f Mon Sep 17 00:00:00 2001 From: Syuugo Date: Thu, 25 Apr 2024 10:35:43 +0900 Subject: [PATCH 181/244] Upgrade build workflow dependencies --- .github/workflows/build.yml | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index c49b25a..378a0cf 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -15,7 +15,7 @@ jobs: sudo apt-get install cabal-install - name: Checkout repository - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 @@ -37,7 +37,7 @@ jobs: mv dist-newstyle/sdist/*.tar.gz source/source.tar.gz - name: Upload artifact - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: source path: source/ @@ -51,10 +51,10 @@ jobs: runs-on: ubuntu-latest steps: - name: Checkout repository - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Download artifacts - uses: actions/download-artifact@v3 + uses: actions/download-artifact@v4 - name: Build source run: | @@ -63,7 +63,7 @@ jobs: ( cd bin && ../build/run_builder ../source/source.tar.gz ../build/${{matrix.build}} ) - name: Upload artifact - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: bin path: bin/ @@ -74,10 +74,10 @@ jobs: runs-on: ubuntu-latest steps: - name: Checkout repository - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Download artifacts - uses: actions/download-artifact@v3 + uses: actions/download-artifact@v4 - name: Work around GitHub permissions bug run: chmod +x bin/*/shellcheck* @@ -92,7 +92,7 @@ jobs: rm -rf */ README* LICENSE* - name: Upload artifact - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: deploy path: deploy/ @@ -109,10 +109,10 @@ jobs: sudo apt-get install hub - name: Checkout repository - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Download artifacts - uses: actions/download-artifact@v3 + uses: actions/download-artifact@v4 - name: Upload to GitHub env: From 796c6bd8482e4666c4f73d2874c3949c2bed801e Mon Sep 17 00:00:00 2001 From: Jan Dubois Date: Wed, 24 Apr 2024 19:05:29 -0700 Subject: [PATCH 182/244] Add new bats variables stderr and stderr_lines These are being set by `run --separate-stderr` and have been introduced in https://github.com/bats-core/bats-core/releases/tag/v1.5.0 --- src/ShellCheck/AnalyzerLib.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index d265ace..a2d61d2 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -535,7 +535,9 @@ getModifiedVariables t = T_BatsTest {} -> [ (t, t, "lines", DataArray SourceExternal), (t, t, "status", DataString SourceInteger), - (t, t, "output", DataString SourceExternal) + (t, t, "output", DataString SourceExternal), + (t, t, "stderr", DataString SourceExternal), + (t, t, "stderr_lines", DataArray SourceExternal) ] -- Count [[ -v foo ]] as an "assignment". From 4f81dbe839091a06a5cfaea695cf1c451ff07565 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 May 2024 14:21:12 -0700 Subject: [PATCH 183/244] Add warning about uninvoked functions, reduce repeated triggering of SC2317 (fixes #2966) --- CHANGELOG.md | 2 ++ src/ShellCheck/Analytics.hs | 23 ++++++++++++++++++++--- 2 files changed, 22 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 25fc688..5277893 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,9 @@ ## Git ### Added - SC2327/SC2328: Warn about capturing the output of redirected commands. +- SC2329: Warn when (non-escaping) functions are never invoked. ### Fixed +- SC2317 about unreachable commands is now less spammy for nested ones. ## v0.10.0 - 2024-03-07 diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 8b74ac6..685fbf4 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4896,16 +4896,33 @@ checkBatsTestDoesNotUseNegation params t = prop_checkCommandIsUnreachable1 = verify checkCommandIsUnreachable "foo; bar; exit; baz" prop_checkCommandIsUnreachable2 = verify checkCommandIsUnreachable "die() { exit; }; foo; bar; die; baz" prop_checkCommandIsUnreachable3 = verifyNot checkCommandIsUnreachable "foo; bar || exit; baz" +prop_checkCommandIsUnreachable4 = verifyNot checkCommandIsUnreachable "f() { foo; }; # Maybe sourced" +prop_checkCommandIsUnreachable5 = verify checkCommandIsUnreachable "f() { foo; }; exit # Not sourced" checkCommandIsUnreachable params t = case t of T_Pipeline {} -> sequence_ $ do cfga <- cfgAnalysis params - state <- CF.getIncomingState cfga id + state <- CF.getIncomingState cfga (getId t) guard . not $ CF.stateIsReachable state guard . not $ isSourced params t - return $ info id 2317 "Command appears to be unreachable. Check usage (or ignore if invoked indirectly)." + guard . not $ any (\t -> isUnreachable t || isUnreachableFunction t) $ NE.drop 1 $ getPath (parentMap params) t + return $ info (getId t) 2317 "Command appears to be unreachable. Check usage (or ignore if invoked indirectly)." + T_Function id _ _ _ _ -> + when (isUnreachableFunction t + && (not . any isUnreachableFunction . NE.drop 1 $ getPath (parentMap params) t) + && (not $ isSourced params t)) $ + info id 2329 "This function is never invoked. Check usage (or ignored if invoked indirectly)." _ -> return () - where id = getId t + where + isUnreachableFunction :: Token -> Bool + isUnreachableFunction f = + case f of + T_Function id _ _ _ t -> isUnreachable t + _ -> False + isUnreachable t = fromMaybe False $ do + cfga <- cfgAnalysis params + state <- CF.getIncomingState cfga (getId t) + return . not $ CF.stateIsReachable state prop_checkOverwrittenExitCode1 = verify checkOverwrittenExitCode "x; [ $? -eq 1 ] || [ $? -eq 2 ]" From 76ff702e9385215a888ed21bf4330f614ab6c355 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 May 2024 15:12:13 -0700 Subject: [PATCH 184/244] Supress SC2015 about `A && B || C` when B is a test. --- CHANGELOG.md | 2 ++ src/ShellCheck/Analytics.hs | 16 +++++----------- src/ShellCheck/AnalyzerLib.hs | 8 ++++++++ 3 files changed, 15 insertions(+), 11 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5277893..fe38b8a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ ### Added - SC2327/SC2328: Warn about capturing the output of redirected commands. - SC2329: Warn when (non-escaping) functions are never invoked. +### Changed +- SC2015 about `A && B || C` no longer triggers when B is a test command. ### Fixed - SC2317 about unreachable commands is now less spammy for nested ones. diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 685fbf4..175dea6 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -877,8 +877,9 @@ prop_checkShorthandIf5 = verifyNot checkShorthandIf "foo && rm || printf b" prop_checkShorthandIf6 = verifyNot checkShorthandIf "if foo && bar || baz; then true; fi" prop_checkShorthandIf7 = verifyNot checkShorthandIf "while foo && bar || baz; do true; done" prop_checkShorthandIf8 = verify checkShorthandIf "if true; then foo && bar || baz; fi" -checkShorthandIf params x@(T_OrIf _ (T_AndIf id _ _) (T_Pipeline _ _ t)) - | not (isOk t || inCondition) = +prop_checkShorthandIf9 = verifyNot checkShorthandIf "foo && [ -x /file ] || bar" +checkShorthandIf params x@(T_OrIf _ (T_AndIf id _ b) (T_Pipeline _ _ t)) + | not (isOk t || inCondition) && not (isTestCommand b) = info id 2015 "Note that A && B || C is not if-then-else. C may run when A is true." where isOk [t] = isAssignment t || fromMaybe False (do @@ -4197,7 +4198,7 @@ checkBadTestAndOr params t = in mapM_ checkTest commandWithSeps checkTest (before, cmd, after) = - when (isTest cmd) $ do + when (isTestCommand cmd) $ do checkPipe before checkPipe after @@ -4213,17 +4214,10 @@ checkBadTestAndOr params t = T_AndIf _ _ rhs -> checkAnds id rhs T_OrIf _ _ rhs -> checkAnds id rhs T_Pipeline _ _ list | not (null list) -> checkAnds id (last list) - cmd -> when (isTest cmd) $ + cmd -> when (isTestCommand cmd) $ errWithFix id 2265 "Use && for logical AND. Single & will background and return true." $ (fixWith [replaceEnd id params 0 "&"]) - isTest t = - case t of - T_Condition {} -> True - T_SimpleCommand {} -> t `isCommand` "test" - T_Redirecting _ _ t -> isTest t - T_Annotation _ _ t -> isTest t - _ -> False prop_checkComparisonWithLeadingX1 = verify checkComparisonWithLeadingX "[ x$foo = xlol ]" prop_checkComparisonWithLeadingX2 = verify checkComparisonWithLeadingX "test x$foo = xlol" diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index d265ace..c6e4e14 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -929,6 +929,14 @@ modifiesVariable params token name = Assignment (_, _, n, source) -> isTrueAssignmentSource source && n == name _ -> False +isTestCommand t = + case t of + T_Condition {} -> True + T_SimpleCommand {} -> t `isCommand` "test" + T_Redirecting _ _ t -> isTestCommand t + T_Annotation _ _ t -> isTestCommand t + T_Pipeline _ _ [t] -> isTestCommand t + _ -> False return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) From d705716dc45d58eef51231292758e2af9e3da30b Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 May 2024 15:22:09 -0700 Subject: [PATCH 185/244] Account for annotations in SC2215. Fixes #2975. --- src/ShellCheck/Analytics.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 175dea6..dcb4ce8 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -4000,6 +4000,7 @@ prop_checkUselessBang6 = verify checkUselessBang "set -e; { ! true; }" prop_checkUselessBang7 = verifyNot checkUselessBang "set -e; x() { ! [ x ]; }" prop_checkUselessBang8 = verifyNot checkUselessBang "set -e; if { ! true; }; then true; fi" prop_checkUselessBang9 = verifyNot checkUselessBang "set -e; while ! true; do true; done" +prop_checkUselessBang10 = verify checkUselessBang "set -e\nshellcheck disable=SC0000\n! true\nrest" checkUselessBang params t = when (hasSetE params) $ mapM_ check (getNonReturningCommands t) where check t = @@ -4008,6 +4009,7 @@ checkUselessBang params t = when (hasSetE params) $ mapM_ check (getNonReturning addComment $ makeCommentWithFix InfoC id 2251 "This ! is not on a condition and skips errexit. Use `&& exit 1` instead, or make sure $? is checked." (fixWith [replaceStart id params 1 "", replaceEnd (getId cmd) params 0 " && exit 1"]) + T_Annotation _ _ t -> check t _ -> return () -- Get all the subcommands that aren't likely to be the return value From a7a906e2cbca41611f232208ae062fe7ddc719f7 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 May 2024 16:28:56 -0700 Subject: [PATCH 186/244] Allow SC2154 to trigger in arrays (fixes #2970) --- src/ShellCheck/Analytics.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index dcb4ce8..dc84a78 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2447,6 +2447,7 @@ prop_checkUnassignedReferences_minusZDefault = verifyNotTree checkUnassignedRefe prop_checkUnassignedReferences50 = verifyNotTree checkUnassignedReferences "echo ${foo:+bar}" prop_checkUnassignedReferences51 = verifyNotTree checkUnassignedReferences "echo ${foo:+$foo}" prop_checkUnassignedReferences52 = verifyNotTree checkUnassignedReferences "wait -p pid; echo $pid" +prop_checkUnassignedReferences53 = verify checkUnassignedReferences "x=($foo)" checkUnassignedReferences = checkUnassignedReferences' False checkUnassignedReferences' includeGlobals params t = warnings @@ -2502,14 +2503,12 @@ checkUnassignedReferences' includeGlobals params t = warnings warnings = execWriter . sequence $ mapMaybe warningFor unassigned - -- Due to parsing, foo=( [bar]=baz ) parses 'bar' as a reference even for assoc arrays. - -- Similarly, ${foo[bar baz]} may not be referencing bar/baz. Just skip these. + -- ${foo[bar baz]} may not be referencing bar/baz. Just skip these. -- We can also have ${foo:+$foo} should be treated like [[ -n $foo ]] && echo $foo isException var t = any shouldExclude $ getPath (parentMap params) t where shouldExclude t = case t of - T_Array {} -> True (T_DollarBraced _ _ l) -> let str = concat $ oversimplify l ref = getBracedReference str From a13cb85f49c074ce6ab4644beaf8665a3ff6f395 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 May 2024 16:34:21 -0700 Subject: [PATCH 187/244] Fixed broken test due to bad build cache --- src/ShellCheck/Analytics.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index dc84a78..f5e57e2 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2447,7 +2447,7 @@ prop_checkUnassignedReferences_minusZDefault = verifyNotTree checkUnassignedRefe prop_checkUnassignedReferences50 = verifyNotTree checkUnassignedReferences "echo ${foo:+bar}" prop_checkUnassignedReferences51 = verifyNotTree checkUnassignedReferences "echo ${foo:+$foo}" prop_checkUnassignedReferences52 = verifyNotTree checkUnassignedReferences "wait -p pid; echo $pid" -prop_checkUnassignedReferences53 = verify checkUnassignedReferences "x=($foo)" +prop_checkUnassignedReferences53 = verifyTree checkUnassignedReferences "x=($foo)" checkUnassignedReferences = checkUnassignedReferences' False checkUnassignedReferences' includeGlobals params t = warnings From ac8fb00504ed6da83fe5c5f83e72e4663ff6b439 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 May 2024 16:45:52 -0700 Subject: [PATCH 188/244] Account for BusyBox support of [[ ]] (fixes #2967) --- CHANGELOG.md | 2 ++ src/ShellCheck/Analytics.hs | 11 ++++++++--- src/ShellCheck/AnalyzerLib.hs | 10 ---------- 3 files changed, 10 insertions(+), 13 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fe38b8a..8ae176d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,10 +2,12 @@ ### Added - SC2327/SC2328: Warn about capturing the output of redirected commands. - SC2329: Warn when (non-escaping) functions are never invoked. +- SC2330: Warn about unsupported glob matches with [[ .. ]] in BusyBox. ### Changed - SC2015 about `A && B || C` no longer triggers when B is a test command. ### Fixed - SC2317 about unreachable commands is now less spammy for nested ones. +- SC2292, optional suggestion for [[ ]], now triggers for Busybox. ## v0.10.0 - 2024-03-07 diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index f5e57e2..a89f940 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1525,6 +1525,7 @@ prop_checkComparisonAgainstGlob3 = verify checkComparisonAgainstGlob "[ $cow = * prop_checkComparisonAgainstGlob4 = verifyNot checkComparisonAgainstGlob "[ $cow = foo ]" prop_checkComparisonAgainstGlob5 = verify checkComparisonAgainstGlob "[[ $cow != $bar ]]" prop_checkComparisonAgainstGlob6 = verify checkComparisonAgainstGlob "[ $f != /* ]" +prop_checkComparisonAgainstGlob7 = verify checkComparisonAgainstGlob "#!/bin/busybox sh\n[[ $f == *foo* ]]" checkComparisonAgainstGlob _ (TC_Binary _ DoubleBracket op _ (T_NormalWord id [T_DollarBraced _ _ _])) | op `elem` ["=", "==", "!="] = warn id 2053 $ "Quote the right-hand side of " ++ op ++ " in [[ ]] to prevent glob matching." @@ -1532,10 +1533,14 @@ checkComparisonAgainstGlob params (TC_Binary _ SingleBracket op _ word) | op `elem` ["=", "==", "!="] && isGlob word = err (getId word) 2081 msg where - msg = if isBashLike params + msg = if (shellType params) `elem` [Bash, Ksh] -- Busybox does not support glob matching then "[ .. ] can't match globs. Use [[ .. ]] or case statement." else "[ .. ] can't match globs. Use a case statement." +checkComparisonAgainstGlob params (TC_Binary _ DoubleBracket op _ word) + | shellType params == BusyboxSh && op `elem` ["=", "==", "!="] && isGlob word = + err (getId word) 2330 "BusyBox [[ .. ]] does not support glob matching. Use a case statement." + checkComparisonAgainstGlob _ _ = return () prop_checkCaseAgainstGlob1 = verify checkCaseAgainstGlob "case foo in lol$n) foo;; esac" @@ -4534,13 +4539,13 @@ prop_checkRequireDoubleBracket2 = verifyTree checkRequireDoubleBracket "[ foo -o prop_checkRequireDoubleBracket3 = verifyNotTree checkRequireDoubleBracket "#!/bin/sh\n[ -x foo ]" prop_checkRequireDoubleBracket4 = verifyNotTree checkRequireDoubleBracket "[[ -x foo ]]" checkRequireDoubleBracket params = - if isBashLike params + if (shellType params) `elem` [Bash, Ksh, BusyboxSh] then nodeChecksToTreeCheck [check] params else const [] where check _ t = case t of T_Condition id SingleBracket _ -> - styleWithFix id 2292 "Prefer [[ ]] over [ ] for tests in Bash/Ksh." (fixFor t) + styleWithFix id 2292 "Prefer [[ ]] over [ ] for tests in Bash/Ksh/Busybox." (fixFor t) _ -> return () fixFor t = fixWith $ diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index c6e4e14..cae73b1 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -902,16 +902,6 @@ supportsArrays Bash = True supportsArrays Ksh = True supportsArrays _ = False --- Returns true if the shell is Bash or Ksh (sorry for the name, Ksh) -isBashLike :: Parameters -> Bool -isBashLike params = - case shellType params of - Bash -> True - Ksh -> True - Dash -> False - BusyboxSh -> False - Sh -> False - isTrueAssignmentSource c = case c of DataString SourceChecked -> False From 78d1ee0222a114597abba1ca8f0784b673bf7d97 Mon Sep 17 00:00:00 2001 From: Bryan Honof Date: Fri, 24 May 2024 17:15:09 +0200 Subject: [PATCH 189/244] Add Flox to list of installation methods --- README.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/README.md b/README.md index 366c427..754f897 100644 --- a/README.md +++ b/README.md @@ -228,6 +228,11 @@ Using the [nix package manager](https://nixos.org/nix): nix-env -iA nixpkgs.shellcheck ``` +Using the [Flox package manager](https://flox.dev/) +```sh +flox install shellcheck +``` + Alternatively, you can download pre-compiled binaries for the latest release here: * [Linux, x86_64](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.linux.x86_64.tar.xz) (statically linked) From 15de97e33f462434272f13e1ec3aa9cd5387441b Mon Sep 17 00:00:00 2001 From: Meng Zhuo Date: Thu, 30 May 2024 19:20:21 +0800 Subject: [PATCH 190/244] Add linux.riscv64 precompiled support --- .github/workflows/build.yml | 2 +- .multi_arch_docker | 1 + CHANGELOG.md | 1 + build/linux.riscv64/Dockerfile | 47 ++++++++++++++++++++++++++++++++++ build/linux.riscv64/build | 15 +++++++++++ build/linux.riscv64/tag | 1 + 6 files changed, 66 insertions(+), 1 deletion(-) create mode 100644 build/linux.riscv64/Dockerfile create mode 100755 build/linux.riscv64/build create mode 100644 build/linux.riscv64/tag diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index c49b25a..e30b2ac 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -47,7 +47,7 @@ jobs: needs: package_source strategy: matrix: - build: [linux.x86_64, linux.aarch64, linux.armv6hf, darwin.x86_64, darwin.aarch64, windows.x86_64] + build: [linux.x86_64, linux.aarch64, linux.armv6hf, linux.riscv64, darwin.x86_64, darwin.aarch64, windows.x86_64] runs-on: ubuntu-latest steps: - name: Checkout repository diff --git a/.multi_arch_docker b/.multi_arch_docker index 1c5d32b..81048a2 100755 --- a/.multi_arch_docker +++ b/.multi_arch_docker @@ -80,6 +80,7 @@ function multi_arch_docker::main() { export DOCKER_PLATFORMS='linux/amd64' DOCKER_PLATFORMS+=' linux/arm64' DOCKER_PLATFORMS+=' linux/arm/v6' + DOCKER_PLATFORMS+=' linux/riscv64' multi_arch_docker::install_docker_buildx multi_arch_docker::login_to_docker_hub diff --git a/CHANGELOG.md b/CHANGELOG.md index 8ae176d..43db00c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,7 @@ - SC2327/SC2328: Warn about capturing the output of redirected commands. - SC2329: Warn when (non-escaping) functions are never invoked. - SC2330: Warn about unsupported glob matches with [[ .. ]] in BusyBox. +- Precompiled binaries for Linux riscv64 (linux.riscv64) ### Changed - SC2015 about `A && B || C` no longer triggers when B is a test command. ### Fixed diff --git a/build/linux.riscv64/Dockerfile b/build/linux.riscv64/Dockerfile new file mode 100644 index 0000000..648ef2d --- /dev/null +++ b/build/linux.riscv64/Dockerfile @@ -0,0 +1,47 @@ +FROM ubuntu:22.04 + +ENV TARGETNAME linux.riscv64 +ENV TARGET riscv64-linux-gnu + +USER root +ENV DEBIAN_FRONTEND noninteractive + +# Init base +RUN apt update -y + +# Install qemu +RUN apt install -y --no-install-recommends build-essential ninja-build python3 pkg-config libglib2.0-dev libpixman-1-dev curl ca-certificates python3-virtualenv +WORKDIR /qemu +RUN curl -Lv "https://download.qemu.org/qemu-9.0.0.tar.xz" | tar xJ --strip-components=1 +RUN ./configure --target-list=riscv64-linux-user --static --disable-system --disable-pie +RUN cd build && ninja qemu-riscv64 +ENV QEMU_EXECVE 1 + + +# Set up a riscv64 userspace +RUN apt install -y --no-install-recommends debootstrap +RUN debootstrap --arch=riscv64 --foreign jammy /rvfs http://ports.ubuntu.com/ubuntu-ports +RUN cp /qemu/build/qemu-riscv64 /rvfs/usr/bin/qemu-riscv64-static + +RUN printf > /bin/rv '%s\n' '#!/bin/sh' 'chroot /rvfs /usr/bin/qemu-riscv64-static /usr/bin/env "$@"' +RUN chmod +x /bin/rv +RUN [ ! -e /rvfs/debootstrap ] || rv '/debootstrap/debootstrap' --second-stage + +# Install deps in the chroot +RUN printf > /rvfs/etc/apt/sources.list '%s\n' 'deb http://ports.ubuntu.com/ubuntu-ports jammy main universe' +RUN rv apt update -y +RUN rv apt install -y --no-install-recommends ghc cabal-install + +# Finally we can build the current dependencies. This takes hours. +# jobs must be 1, GHS riscv will use about 40G memory +RUN rv cabal update +RUN IFS=";" && rv cabal install --dependencies-only --jobs=1 ShellCheck +RUN IFS=';' && rv cabal install --lib --jobs=1 fgl + +# Clean up +RUN rm -rf /qemu + +# Copy the build script +WORKDIR /rvfs/scratch +COPY build /rvfs/usr/bin/build +ENTRYPOINT ["/bin/rv", "/usr/bin/build"] diff --git a/build/linux.riscv64/build b/build/linux.riscv64/build new file mode 100755 index 0000000..19cb143 --- /dev/null +++ b/build/linux.riscv64/build @@ -0,0 +1,15 @@ +#!/bin/sh +set -xe +{ + tar xzv --strip-components=1 + chmod +x striptests && ./striptests + mkdir "$TARGETNAME" + cabal update + ( IFS=';'; cabal build --enable-executable-static ) + find . -name shellcheck -type f -exec mv {} "$TARGETNAME/" \; + ls -l "$TARGETNAME" + "$TARGET-strip" -s "$TARGETNAME/shellcheck" + ls -l "$TARGETNAME" + qemu-riscv64-static "$TARGETNAME/shellcheck" --version +} >&2 +tar czv "$TARGETNAME" diff --git a/build/linux.riscv64/tag b/build/linux.riscv64/tag new file mode 100644 index 0000000..901eaaa --- /dev/null +++ b/build/linux.riscv64/tag @@ -0,0 +1 @@ +koalaman/scbuilder-linux-riscv64 From 23e76de4f2a640ecd7c8c1da23495d985ef095e6 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 11 Jun 2024 06:00:22 +0000 Subject: [PATCH 191/244] Allow riscv64 image to run without binfmt_misc --- build/linux.riscv64/Dockerfile | 44 ++++++----- build/linux.riscv64/build | 10 ++- build/linux.riscv64/cabal.project.freeze | 93 ++++++++++++++++++++++++ 3 files changed, 126 insertions(+), 21 deletions(-) create mode 100644 build/linux.riscv64/cabal.project.freeze diff --git a/build/linux.riscv64/Dockerfile b/build/linux.riscv64/Dockerfile index 648ef2d..0ac95e5 100644 --- a/build/linux.riscv64/Dockerfile +++ b/build/linux.riscv64/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:22.04 +FROM ubuntu:24.04 ENV TARGETNAME linux.riscv64 ENV TARGET riscv64-linux-gnu @@ -7,39 +7,47 @@ USER root ENV DEBIAN_FRONTEND noninteractive # Init base -RUN apt update -y +RUN apt-get update -y # Install qemu -RUN apt install -y --no-install-recommends build-essential ninja-build python3 pkg-config libglib2.0-dev libpixman-1-dev curl ca-certificates python3-virtualenv +RUN apt-get install -y --no-install-recommends build-essential ninja-build python3 pkg-config libglib2.0-dev libpixman-1-dev curl ca-certificates python3-virtualenv git python3-setuptools WORKDIR /qemu -RUN curl -Lv "https://download.qemu.org/qemu-9.0.0.tar.xz" | tar xJ --strip-components=1 -RUN ./configure --target-list=riscv64-linux-user --static --disable-system --disable-pie +RUN git clone --depth 1 https://github.com/koalaman/qemu . +#RUN git clone https://github.com/balena-io/qemu . +# Release 7.0.0 +#RUN git checkout 639d1d8903f65d74eb04c49e0df7a4b2f014cd86 +RUN ./configure --target-list=riscv64-linux-user --static --disable-system --disable-pie --disable-werror RUN cd build && ninja qemu-riscv64 ENV QEMU_EXECVE 1 # Set up a riscv64 userspace -RUN apt install -y --no-install-recommends debootstrap -RUN debootstrap --arch=riscv64 --foreign jammy /rvfs http://ports.ubuntu.com/ubuntu-ports +RUN apt-get install -y --no-install-recommends debootstrap +RUN debootstrap --arch=riscv64 --foreign noble /rvfs http://ports.ubuntu.com/ubuntu-ports RUN cp /qemu/build/qemu-riscv64 /rvfs/usr/bin/qemu-riscv64-static -RUN printf > /bin/rv '%s\n' '#!/bin/sh' 'chroot /rvfs /usr/bin/qemu-riscv64-static /usr/bin/env "$@"' +# Command to run riscv binaries in the chroot. The Haskell runtime allocates 1TB +# vspace up front and QEmu has a RAM cost per vspace, so use ulimit to allocate +# less and reduce RAM usage. +RUN printf > /bin/rv '%s\n' '#!/bin/sh' 'ulimit -v $((10*1024*1024)); chroot /rvfs /usr/bin/qemu-riscv64-static /usr/bin/env "$@"' RUN chmod +x /bin/rv RUN [ ! -e /rvfs/debootstrap ] || rv '/debootstrap/debootstrap' --second-stage # Install deps in the chroot -RUN printf > /rvfs/etc/apt/sources.list '%s\n' 'deb http://ports.ubuntu.com/ubuntu-ports jammy main universe' -RUN rv apt update -y -RUN rv apt install -y --no-install-recommends ghc cabal-install +RUN printf > /rvfs/etc/apt/sources.list '%s\n' 'deb http://ports.ubuntu.com/ubuntu-ports noble main universe' +RUN rv apt-get update -y +RUN rv apt-get install -y --no-install-recommends ghc cabal-install -# Finally we can build the current dependencies. This takes hours. -# jobs must be 1, GHS riscv will use about 40G memory RUN rv cabal update -RUN IFS=";" && rv cabal install --dependencies-only --jobs=1 ShellCheck -RUN IFS=';' && rv cabal install --lib --jobs=1 fgl - -# Clean up -RUN rm -rf /qemu +# Generated with: cabal freeze -c 'hashable -arch-native'. We put it in /etc so cabal won't find it. +COPY cabal.project.freeze /rvfs/etc +# Awful hack to install everything from the freeze file +# This basically turns 'any.tagged ==0.8.8' into tagged-0.8.8 to install by version, +# and adds a -c before 'hashable -arch-native +integer-gmp' to make it a flag constraint. +RUN < /rvfs/etc/cabal.project.freeze sed 's/constraints:/&\n /' | grep -vw rts | sed -n -e 's/^ *\([^,]*\).*/\1/p' | sed -e 's/any\.\([^ ]*\) ==\(.*\)/\1-\2/; te; s/.*/-c\n&/; :e' > /tmp/preinstall-flags +# Finally we can build the current dependencies. This takes hours. +# There's apparently a random segfault during assembly, so retry a few times. +RUN set -x; IFS=${IFS# }; f() { rv cabal install --keep-going $(cat /tmp/preinstall-flags); }; for i in $(seq 5); do f; ret=$?; [ $ret = 0 ] && break; done; exit $ret # Copy the build script WORKDIR /rvfs/scratch diff --git a/build/linux.riscv64/build b/build/linux.riscv64/build index 19cb143..63c487f 100755 --- a/build/linux.riscv64/build +++ b/build/linux.riscv64/build @@ -1,15 +1,19 @@ #!/bin/sh set -xe +IFS=';' { tar xzv --strip-components=1 chmod +x striptests && ./striptests + # Use a freeze file to ensure we use the same dependencies we cached during + # the docker image build. We don't want to spend time compiling anything new. + cp /etc/cabal.project.freeze . mkdir "$TARGETNAME" - cabal update - ( IFS=';'; cabal build --enable-executable-static ) + # Retry in case of random segfault + cabal build --enable-executable-static || cabal build --enable-executable-static find . -name shellcheck -type f -exec mv {} "$TARGETNAME/" \; ls -l "$TARGETNAME" "$TARGET-strip" -s "$TARGETNAME/shellcheck" ls -l "$TARGETNAME" - qemu-riscv64-static "$TARGETNAME/shellcheck" --version + "$TARGETNAME/shellcheck" --version } >&2 tar czv "$TARGETNAME" diff --git a/build/linux.riscv64/cabal.project.freeze b/build/linux.riscv64/cabal.project.freeze new file mode 100644 index 0000000..cbb42e1 --- /dev/null +++ b/build/linux.riscv64/cabal.project.freeze @@ -0,0 +1,93 @@ +active-repositories: hackage.haskell.org:merge +constraints: any.Diff ==0.5, + any.OneTuple ==0.4.2, + any.QuickCheck ==2.14.3, + QuickCheck -old-random +templatehaskell, + any.StateVar ==1.2.2, + any.aeson ==2.2.3.0, + aeson +ordered-keymap, + any.array ==0.5.4.0, + any.assoc ==1.1.1, + assoc -tagged, + any.base ==4.17.2.0, + any.base-orphans ==0.9.2, + any.bifunctors ==5.6.2, + bifunctors +tagged, + any.binary ==0.8.9.1, + any.bytestring ==0.11.5.2, + any.character-ps ==0.1, + any.comonad ==5.0.8, + comonad +containers +distributive +indexed-traversable, + any.containers ==0.6.7, + any.contravariant ==1.5.5, + contravariant +semigroups +statevar +tagged, + any.data-fix ==0.3.3, + any.deepseq ==1.4.8.0, + any.directory ==1.3.7.1, + any.distributive ==0.6.2.1, + distributive +semigroups +tagged, + any.dlist ==1.0, + dlist -werror, + any.exceptions ==0.10.5, + any.fgl ==5.8.2.0, + fgl +containers042, + any.filepath ==1.4.2.2, + any.foldable1-classes-compat ==0.1, + foldable1-classes-compat +tagged, + any.generically ==0.1.1, + any.ghc-bignum ==1.3, + any.ghc-boot-th ==9.4.7, + any.ghc-prim ==0.9.1, + any.hashable ==1.4.6.0, + hashable -arch-native +integer-gmp -random-initial-seed, + any.indexed-traversable ==0.1.4, + any.indexed-traversable-instances ==0.1.2, + any.integer-conversion ==0.1.1, + any.integer-logarithms ==1.0.3.1, + integer-logarithms -check-bounds +integer-gmp, + any.mtl ==2.2.2, + any.network-uri ==2.6.4.2, + any.os-string ==2.0.3, + any.parsec ==3.1.16.1, + any.pretty ==1.1.3.6, + any.primitive ==0.9.0.0, + any.process ==1.6.17.0, + any.random ==1.2.1.2, + any.regex-base ==0.94.0.2, + any.regex-tdfa ==1.3.2.2, + regex-tdfa +doctest -force-o2, + any.rts ==1.0.2, + any.scientific ==0.3.8.0, + scientific -integer-simple, + any.semialign ==1.3.1, + semialign +semigroupoids, + any.semigroupoids ==6.0.1, + semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, + any.splitmix ==0.1.0.5, + splitmix -optimised-mixer, + any.stm ==2.5.1.0, + any.strict ==0.5, + any.tagged ==0.8.8, + tagged +deepseq +transformers, + any.template-haskell ==2.19.0.0, + any.text ==2.0.2, + any.text-iso8601 ==0.1.1, + any.text-short ==0.1.6, + text-short -asserts, + any.th-abstraction ==0.7.0.0, + any.th-compat ==0.1.5, + any.these ==1.2.1, + any.time ==1.12.2, + any.time-compat ==1.9.7, + any.transformers ==0.5.6.2, + any.transformers-compat ==0.7.2, + transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, + any.unix ==2.7.3, + any.unordered-containers ==0.2.20, + unordered-containers -debug, + any.uuid-types ==1.0.6, + any.vector ==0.13.1.0, + vector +boundschecks -internalchecks -unsafechecks -wall, + any.vector-stream ==0.1.0.1, + any.witherable ==0.5 +index-state: hackage.haskell.org 2024-06-17T00:48:51Z From 3946cbd4a0b477700172c04be7baa3f43777bc99 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 24 Jun 2024 05:12:21 +0000 Subject: [PATCH 192/244] Upgrade docker build images --- build/README.md | 4 + build/darwin.aarch64/build | 1 - build/darwin.x86_64/build | 1 - build/linux.aarch64/Dockerfile | 2 +- build/linux.aarch64/build | 1 - build/linux.armv6hf/Dockerfile | 64 ++++++---------- build/linux.armv6hf/build | 3 +- build/linux.armv6hf/cabal.project.freeze | 93 ++++++++++++++++++++++++ build/linux.armv6hf/scutil | 48 ++++++++++++ build/linux.riscv64/Dockerfile | 49 +++++-------- build/linux.riscv64/build | 4 +- build/windows.x86_64/build | 1 - 12 files changed, 194 insertions(+), 77 deletions(-) create mode 100644 build/linux.armv6hf/cabal.project.freeze create mode 100644 build/linux.armv6hf/scutil diff --git a/build/README.md b/build/README.md index eb745a0..31e8607 100644 --- a/build/README.md +++ b/build/README.md @@ -11,3 +11,7 @@ This makes it simple to build any release without exotic hardware or software. An image can be built and tagged using `build_builder`, and run on a source tarball using `run_builder`. + +Tip: Are you developing an image that relies on QEmu usermode emulation? + It's easy to accidentally depend on binfmt\_misc on the host OS. + Do a `echo 0 | sudo tee /proc/sys/fs/binfmt_misc/status` before testing. diff --git a/build/darwin.aarch64/build b/build/darwin.aarch64/build index 4235d3a..ff522ff 100755 --- a/build/darwin.aarch64/build +++ b/build/darwin.aarch64/build @@ -4,7 +4,6 @@ set -xe tar xzv --strip-components=1 chmod +x striptests && ./striptests mkdir "$TARGETNAME" - cabal update ( IFS=';'; cabal build $CABALOPTS ) find . -name shellcheck -type f -exec mv {} "$TARGETNAME/" \; ls -l "$TARGETNAME" diff --git a/build/darwin.x86_64/build b/build/darwin.x86_64/build index 53857e8..058cece 100755 --- a/build/darwin.x86_64/build +++ b/build/darwin.x86_64/build @@ -4,7 +4,6 @@ set -xe tar xzv --strip-components=1 chmod +x striptests && ./striptests mkdir "$TARGETNAME" - cabal update ( IFS=';'; cabal build $CABALOPTS ) find . -name shellcheck -type f -exec mv {} "$TARGETNAME/" \; ls -l "$TARGETNAME" diff --git a/build/linux.aarch64/Dockerfile b/build/linux.aarch64/Dockerfile index fadb6a4..1ffe1bd 100644 --- a/build/linux.aarch64/Dockerfile +++ b/build/linux.aarch64/Dockerfile @@ -28,7 +28,7 @@ RUN curl -L "https://downloads.haskell.org/~cabal/cabal-install-3.9.0.0/cabal-in # Due to an apparent cabal bug, we specify our options directly to cabal # It won't reuse caches if ghc-options are specified in ~/.cabal/config -ENV CABALOPTS "--ghc-options;-split-sections -optc-Os -optc-Wl,--gc-sections -optc-fPIC;--with-ghc=$TARGET-ghc;--with-hc-pkg=$TARGET-ghc-pkg" +ENV CABALOPTS "--ghc-options;-split-sections -optc-Os -optc-Wl,--gc-sections -optc-fPIC;--with-ghc=$TARGET-ghc;--with-hc-pkg=$TARGET-ghc-pkg;-c;hashable -arch-native" # Prebuild the dependencies RUN cabal update && IFS=';' && cabal install --dependencies-only $CABALOPTS ShellCheck diff --git a/build/linux.aarch64/build b/build/linux.aarch64/build index f8001aa..3ce61ce 100755 --- a/build/linux.aarch64/build +++ b/build/linux.aarch64/build @@ -4,7 +4,6 @@ set -xe tar xzv --strip-components=1 chmod +x striptests && ./striptests mkdir "$TARGETNAME" - cabal update ( IFS=';'; cabal build $CABALOPTS --enable-executable-static ) find . -name shellcheck -type f -exec mv {} "$TARGETNAME/" \; ls -l "$TARGETNAME" diff --git a/build/linux.armv6hf/Dockerfile b/build/linux.armv6hf/Dockerfile index f933dda..b4d4197 100644 --- a/build/linux.armv6hf/Dockerfile +++ b/build/linux.armv6hf/Dockerfile @@ -1,25 +1,7 @@ -# I've again spent days trying to get a working armv6hf compiler going. -# God only knows how many recompilations of GCC, GHC, libraries, and -# ShellCheck itself, has gone into it. -# -# I tried Debian's toolchain. I tried my custom one built according to -# RPi `gcc -v`. I tried GHC9, glibc, musl, registerised vs not, but -# nothing has yielded an armv6hf binary that does not immediately -# segfault on qemu-arm-static or the RPi itself. -# -# I then tried the same but with armv7hf. Same story. -# -# Emulating the entire userspace with balenalib again? Very strange build -# failures where programs would fail to execute with > ~100 arguments. -# -# Finally, creating our own appears to work when using a custom QEmu -# patched to follow execve calls. -# -# PS: $100 bounty for getting a RPi1 compatible static build going -# with cross-compilation, similar to what the aarch64 build does. -# +# This Docker file uses a custom QEmu fork with patches to follow execve +# to build all of ShellCheck emulated. -FROM ubuntu:20.04 +FROM ubuntu:24.04 ENV TARGETNAME linux.armv6hf @@ -27,34 +9,34 @@ ENV TARGETNAME linux.armv6hf USER root ENV DEBIAN_FRONTEND noninteractive RUN apt-get update -RUN apt-get install -y build-essential git ninja-build python3 pkg-config libglib2.0-dev libpixman-1-dev -WORKDIR /build -RUN git clone --depth 1 https://github.com/koalaman/qemu -RUN cd qemu && ./configure --static && cd build && ninja qemu-arm -RUN cp qemu/build/qemu-arm /build/qemu-arm-static +RUN apt-get install -y --no-install-recommends build-essential git ninja-build python3 pkg-config libglib2.0-dev libpixman-1-dev python3-setuptools ca-certificates debootstrap +WORKDIR /qemu +RUN git clone --depth 1 https://github.com/koalaman/qemu . +RUN ./configure --static --disable-werror && cd build && ninja qemu-arm ENV QEMU_EXECVE 1 +# Convenience utility +COPY scutil /bin/scutil +COPY scutil /chroot/bin/scutil +RUN chmod +x /bin/scutil /chroot/bin/scutil + # Set up an armv6 userspace WORKDIR / -RUN apt-get install -y debootstrap qemu-user-static -# We expect this to fail if the host doesn't have binfmt qemu support -RUN qemu-debootstrap --arch armhf bullseye pi http://mirrordirector.raspbian.org/raspbian || [ -e /pi/etc/issue ] -RUN cp /build/qemu-arm-static /pi/usr/bin/qemu-arm-static -RUN printf > /bin/pirun '%s\n' '#!/bin/sh' 'chroot /pi /usr/bin/qemu-arm-static /usr/bin/env "$@"' && chmod +x /bin/pirun -# If the debootstrap process didn't finish, continue it -RUN [ ! -e /pi/debootstrap ] || pirun '/debootstrap/debootstrap' --second-stage +RUN debootstrap --arch armhf --variant=minbase --foreign bookworm /chroot http://mirrordirector.raspbian.org/raspbian +RUN cp /qemu/build/qemu-arm /chroot/bin/qemu +RUN scutil emu /debootstrap/debootstrap --second-stage # Install deps in the chroot -RUN pirun apt-get update -RUN pirun apt-get install -y ghc cabal-install +RUN scutil emu apt-get update +RUN scutil emu apt-get install -y --no-install-recommends ghc cabal-install +RUN scutil emu cabal update # Finally we can build the current dependencies. This takes hours. ENV CABALOPTS "--ghc-options;-split-sections -optc-Os -optc-Wl,--gc-sections;--gcc-options;-Os -Wl,--gc-sections -ffunction-sections -fdata-sections" -RUN pirun cabal update -RUN IFS=";" && pirun cabal install --dependencies-only $CABALOPTS ShellCheck -RUN IFS=';' && pirun cabal install $CABALOPTS --lib fgl +# Generated with `cabal freeze --constraint 'hashable -arch-native'` +COPY cabal.project.freeze /chroot/etc +RUN IFS=";" && scutil install_from_freeze /chroot/etc/cabal.project.freeze emu cabal install $CABALOPTS # Copy the build script -WORKDIR /pi/scratch -COPY build /pi/usr/bin -ENTRYPOINT ["/bin/pirun", "/usr/bin/build"] +COPY build /chroot/bin +ENTRYPOINT ["/bin/scutil", "emu", "/bin/build"] diff --git a/build/linux.armv6hf/build b/build/linux.armv6hf/build index daa94d9..1d496ae 100755 --- a/build/linux.armv6hf/build +++ b/build/linux.armv6hf/build @@ -1,8 +1,9 @@ #!/bin/sh set -xe -cd /scratch +mkdir /scratch && cd /scratch { tar xzv --strip-components=1 + cp /etc/cabal.project.freeze . chmod +x striptests && ./striptests mkdir "$TARGETNAME" # This script does not cabal update because compiling anything new is slow diff --git a/build/linux.armv6hf/cabal.project.freeze b/build/linux.armv6hf/cabal.project.freeze new file mode 100644 index 0000000..183bcc6 --- /dev/null +++ b/build/linux.armv6hf/cabal.project.freeze @@ -0,0 +1,93 @@ +active-repositories: hackage.haskell.org:merge +constraints: any.Diff ==0.5, + any.OneTuple ==0.4.2, + any.QuickCheck ==2.14.3, + QuickCheck -old-random +templatehaskell, + any.StateVar ==1.2.2, + any.aeson ==2.2.3.0, + aeson +ordered-keymap, + any.array ==0.5.4.0, + any.assoc ==1.1.1, + assoc -tagged, + any.base ==4.15.1.0, + any.base-orphans ==0.9.2, + any.bifunctors ==5.6.2, + bifunctors +tagged, + any.binary ==0.8.8.0, + any.bytestring ==0.10.12.1, + any.character-ps ==0.1, + any.comonad ==5.0.8, + comonad +containers +distributive +indexed-traversable, + any.containers ==0.6.4.1, + any.contravariant ==1.5.5, + contravariant +semigroups +statevar +tagged, + any.data-array-byte ==0.1.0.1, + any.data-fix ==0.3.3, + any.deepseq ==1.4.5.0, + any.directory ==1.3.6.2, + any.distributive ==0.6.2.1, + distributive +semigroups +tagged, + any.dlist ==1.0, + dlist -werror, + any.exceptions ==0.10.4, + any.fgl ==5.8.2.0, + fgl +containers042, + any.filepath ==1.4.2.1, + any.foldable1-classes-compat ==0.1, + foldable1-classes-compat +tagged, + any.generically ==0.1.1, + any.ghc-bignum ==1.1, + any.ghc-boot-th ==9.0.2, + any.ghc-prim ==0.7.0, + any.hashable ==1.4.6.0, + hashable -arch-native +integer-gmp -random-initial-seed, + any.indexed-traversable ==0.1.4, + any.indexed-traversable-instances ==0.1.2, + any.integer-conversion ==0.1.1, + any.integer-logarithms ==1.0.3.1, + integer-logarithms -check-bounds +integer-gmp, + any.mtl ==2.2.2, + any.network-uri ==2.6.4.2, + any.parsec ==3.1.14.0, + any.pretty ==1.1.3.6, + any.primitive ==0.9.0.0, + any.process ==1.6.13.2, + any.random ==1.2.1.2, + any.regex-base ==0.94.0.2, + any.regex-tdfa ==1.3.2.2, + regex-tdfa +doctest -force-o2, + any.rts ==1.0.2, + any.scientific ==0.3.8.0, + scientific -integer-simple, + any.semialign ==1.3.1, + semialign +semigroupoids, + any.semigroupoids ==6.0.1, + semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, + any.splitmix ==0.1.0.5, + splitmix -optimised-mixer, + any.stm ==2.5.0.0, + any.strict ==0.5, + any.tagged ==0.8.8, + tagged +deepseq +transformers, + any.template-haskell ==2.17.0.0, + any.text ==1.2.5.0, + any.text-iso8601 ==0.1.1, + any.text-short ==0.1.6, + text-short -asserts, + any.th-abstraction ==0.7.0.0, + any.th-compat ==0.1.5, + any.these ==1.2.1, + any.time ==1.9.3, + any.time-compat ==1.9.7, + any.transformers ==0.5.6.2, + any.transformers-compat ==0.7.2, + transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, + any.unix ==2.7.2.2, + any.unordered-containers ==0.2.20, + unordered-containers -debug, + any.uuid-types ==1.0.6, + any.vector ==0.13.1.0, + vector +boundschecks -internalchecks -unsafechecks -wall, + any.vector-stream ==0.1.0.1, + any.witherable ==0.5 +index-state: hackage.haskell.org 2024-06-18T02:21:19Z diff --git a/build/linux.armv6hf/scutil b/build/linux.armv6hf/scutil new file mode 100644 index 0000000..a85d810 --- /dev/null +++ b/build/linux.armv6hf/scutil @@ -0,0 +1,48 @@ +#!/bin/dash +# Various ShellCheck build utility functions + +# Generally set a ulimit to avoid QEmu using too much memory +ulimit -v "$((10*1024*1024))" +# If we happen to invoke or run under QEmu, make sure to follow execve. +# This requires a patched QEmu. +export QEMU_EXECVE=1 + +# Retry a command until it succeeds +# Usage: scutil retry 3 mycmd +retry() { + n="$1" + ret=1 + shift + while [ "$n" -gt 0 ] + do + "$@" + ret=$? + [ "$ret" = 0 ] && break + n=$((n-1)) + done + return "$ret" +} + +# Install all dependencies from a freeze file +# Usage: scutil install_from_freeze /path/cabal.project.freeze cabal install +install_from_freeze() { + linefeed=$(printf '\nx') + linefeed=${linefeed%x} + flags=$( + sed 's/constraints:/&\n /' "$1" | + grep -vw -e rts -e base | + sed -n -e 's/^ *\([^,]*\).*/\1/p' | + sed -e 's/any\.\([^ ]*\) ==\(.*\)/\1-\2/; te; s/.*/--constraint\n&/; :e') + shift + # shellcheck disable=SC2086 + ( IFS=$linefeed; set -x; "$@" $flags ) +} + +# Run a command under emulation. +# This assumes the correct emulator is named 'qemu' and the chroot is /chroot +# Usage: scutil emu echo "Hello World" +emu() { + chroot /chroot /bin/qemu /usr/bin/env "$@" +} + +"$@" diff --git a/build/linux.riscv64/Dockerfile b/build/linux.riscv64/Dockerfile index 0ac95e5..d138ff7 100644 --- a/build/linux.riscv64/Dockerfile +++ b/build/linux.riscv64/Dockerfile @@ -10,46 +10,37 @@ ENV DEBIAN_FRONTEND noninteractive RUN apt-get update -y # Install qemu -RUN apt-get install -y --no-install-recommends build-essential ninja-build python3 pkg-config libglib2.0-dev libpixman-1-dev curl ca-certificates python3-virtualenv git python3-setuptools +RUN apt-get install -y --no-install-recommends build-essential ninja-build python3 pkg-config libglib2.0-dev libpixman-1-dev curl ca-certificates python3-virtualenv git python3-setuptools debootstrap WORKDIR /qemu RUN git clone --depth 1 https://github.com/koalaman/qemu . -#RUN git clone https://github.com/balena-io/qemu . -# Release 7.0.0 -#RUN git checkout 639d1d8903f65d74eb04c49e0df7a4b2f014cd86 RUN ./configure --target-list=riscv64-linux-user --static --disable-system --disable-pie --disable-werror RUN cd build && ninja qemu-riscv64 ENV QEMU_EXECVE 1 +# Convenience utility +COPY scutil /bin/scutil +# We have to copy to /usr/bin because debootstrap will try to symlink /bin and fail if it exists +COPY scutil /chroot/usr/bin/scutil +RUN chmod +x /bin/scutil /chroot/usr/bin/scutil # Set up a riscv64 userspace -RUN apt-get install -y --no-install-recommends debootstrap -RUN debootstrap --arch=riscv64 --foreign noble /rvfs http://ports.ubuntu.com/ubuntu-ports -RUN cp /qemu/build/qemu-riscv64 /rvfs/usr/bin/qemu-riscv64-static - -# Command to run riscv binaries in the chroot. The Haskell runtime allocates 1TB -# vspace up front and QEmu has a RAM cost per vspace, so use ulimit to allocate -# less and reduce RAM usage. -RUN printf > /bin/rv '%s\n' '#!/bin/sh' 'ulimit -v $((10*1024*1024)); chroot /rvfs /usr/bin/qemu-riscv64-static /usr/bin/env "$@"' -RUN chmod +x /bin/rv -RUN [ ! -e /rvfs/debootstrap ] || rv '/debootstrap/debootstrap' --second-stage +WORKDIR / +RUN debootstrap --arch=riscv64 --variant=minbase --components=main,universe --foreign noble /chroot http://ports.ubuntu.com/ubuntu-ports +RUN cp /qemu/build/qemu-riscv64 /chroot/bin/qemu +RUN scutil emu /debootstrap/debootstrap --second-stage # Install deps in the chroot -RUN printf > /rvfs/etc/apt/sources.list '%s\n' 'deb http://ports.ubuntu.com/ubuntu-ports noble main universe' -RUN rv apt-get update -y -RUN rv apt-get install -y --no-install-recommends ghc cabal-install +RUN scutil emu apt-get update +RUN scutil emu apt-get install -y --no-install-recommends ghc cabal-install +RUN scutil emu cabal update -RUN rv cabal update # Generated with: cabal freeze -c 'hashable -arch-native'. We put it in /etc so cabal won't find it. -COPY cabal.project.freeze /rvfs/etc -# Awful hack to install everything from the freeze file -# This basically turns 'any.tagged ==0.8.8' into tagged-0.8.8 to install by version, -# and adds a -c before 'hashable -arch-native +integer-gmp' to make it a flag constraint. -RUN < /rvfs/etc/cabal.project.freeze sed 's/constraints:/&\n /' | grep -vw rts | sed -n -e 's/^ *\([^,]*\).*/\1/p' | sed -e 's/any\.\([^ ]*\) ==\(.*\)/\1-\2/; te; s/.*/-c\n&/; :e' > /tmp/preinstall-flags -# Finally we can build the current dependencies. This takes hours. -# There's apparently a random segfault during assembly, so retry a few times. -RUN set -x; IFS=${IFS# }; f() { rv cabal install --keep-going $(cat /tmp/preinstall-flags); }; for i in $(seq 5); do f; ret=$?; [ $ret = 0 ] && break; done; exit $ret +COPY cabal.project.freeze /chroot/etc + +# Build all dependencies from the freeze file. The emulator segfaults at random, +# so retry a few times. +RUN scutil install_from_freeze /chroot/etc/cabal.project.freeze retry 5 emu cabal install --keep-going # Copy the build script -WORKDIR /rvfs/scratch -COPY build /rvfs/usr/bin/build -ENTRYPOINT ["/bin/rv", "/usr/bin/build"] +COPY build /chroot/bin/build +ENTRYPOINT ["/bin/scutil", "emu", "/bin/build"] diff --git a/build/linux.riscv64/build b/build/linux.riscv64/build index 63c487f..ed9dc27 100755 --- a/build/linux.riscv64/build +++ b/build/linux.riscv64/build @@ -2,6 +2,8 @@ set -xe IFS=';' { + mkdir -p /tmp/scratch + cd /tmp/scratch tar xzv --strip-components=1 chmod +x striptests && ./striptests # Use a freeze file to ensure we use the same dependencies we cached during @@ -9,7 +11,7 @@ IFS=';' cp /etc/cabal.project.freeze . mkdir "$TARGETNAME" # Retry in case of random segfault - cabal build --enable-executable-static || cabal build --enable-executable-static + scutil retry 3 cabal build --enable-executable-static find . -name shellcheck -type f -exec mv {} "$TARGETNAME/" \; ls -l "$TARGETNAME" "$TARGET-strip" -s "$TARGETNAME/shellcheck" diff --git a/build/windows.x86_64/build b/build/windows.x86_64/build index 7bf186e..22e5b42 100755 --- a/build/windows.x86_64/build +++ b/build/windows.x86_64/build @@ -8,7 +8,6 @@ set -xe tar xzv --strip-components=1 chmod +x striptests && ./striptests mkdir "$TARGETNAME" - cabal update ( IFS=';'; cabal build $CABALOPTS ) find dist*/ -name shellcheck.exe -type f -ls -exec mv {} "$TARGETNAME/" \; ls -l "$TARGETNAME" From b408f546209bdd344177d2d778b38d3a77f0db78 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 7 Jul 2024 01:03:40 -0400 Subject: [PATCH 193/244] Simplify invokedNodes --- src/ShellCheck/CFGAnalysis.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 0b99c9f..8534d6f 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -1350,7 +1350,7 @@ analyzeControlFlow params t = -- All nodes we've touched invocations <- readSTRef $ cInvocations ctx - let invokedNodes = M.fromDistinctAscList $ map (\c -> (c, ())) $ S.toList $ M.keysSet $ groupByNode $ M.map snd invocations + let invokedNodes = M.fromSet (const ()) $ S.unions $ map (M.keysSet . snd) $ M.elems invocations -- Invoke all functions that were declared but not invoked -- This is so that we still get warnings for dead code From 61b7e66f809d9c2d1be06e5787ae6a98039e798e Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 7 Jul 2024 01:07:39 -0400 Subject: [PATCH 194/244] Use sets instead of maps that never use their values --- src/ShellCheck/Analytics.hs | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index a89f940..621f70a 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -491,14 +491,14 @@ checkWrongArithmeticAssignment params (T_SimpleCommand id [T_Assignment _ _ _ _ sequence_ $ do str <- getNormalString val var:op:_ <- matchRegex regex str - Map.lookup var references + guard $ S.member var references return . warn (getId val) 2100 $ "Use $((..)) for arithmetics, e.g. i=$((i " ++ op ++ " 2))" where regex = mkRegex "^([_a-zA-Z][_a-zA-Z0-9]*)([+*-]).+$" - references = foldl (flip ($)) Map.empty (map insertRef $ variableFlow params) + references = foldl (flip ($)) S.empty (map insertRef $ variableFlow params) insertRef (Assignment (_, _, name, _)) = - Map.insert name () + S.insert name insertRef _ = Prelude.id getNormalString (T_NormalWord _ words) = do @@ -974,32 +974,32 @@ prop_checkArrayWithoutIndex9 = verifyTree checkArrayWithoutIndex "read -r -a arr prop_checkArrayWithoutIndex10 = verifyTree checkArrayWithoutIndex "read -ra arr <<< 'foo bar'; echo \"$arr\"" prop_checkArrayWithoutIndex11 = verifyNotTree checkArrayWithoutIndex "read -rpfoobar r; r=42" checkArrayWithoutIndex params _ = - doVariableFlowAnalysis readF writeF defaultMap (variableFlow params) + doVariableFlowAnalysis readF writeF defaultSet (variableFlow params) where - defaultMap = Map.fromList $ map (\x -> (x,())) arrayVariables + defaultSet = S.fromList arrayVariables readF _ (T_DollarBraced id _ token) _ = do - map <- get + s <- get return . maybeToList $ do name <- getLiteralString token - assigned <- Map.lookup name map + guard $ S.member name s return $ makeComment WarningC id 2128 "Expanding an array without an index only gives the first element." readF _ _ _ = return [] writeF _ (T_Assignment id mode name [] _) _ (DataString _) = do - isArray <- gets (Map.member name) + isArray <- gets (S.member name) return $ if not isArray then [] else case mode of Assign -> [makeComment WarningC id 2178 "Variable was used as an array but is now assigned a string."] Append -> [makeComment WarningC id 2179 "Use array+=(\"item\") to append items to an array."] writeF _ t name (DataArray _) = do - modify (Map.insert name ()) + modify (S.insert name) return [] writeF _ expr name _ = do if isIndexed expr - then modify (Map.insert name ()) - else modify (Map.delete name) + then modify (S.insert name) + else modify (S.delete name) return [] isIndexed expr = @@ -3968,12 +3968,12 @@ prop_checkTranslatedStringVariable4 = verifyNot checkTranslatedStringVariable "v prop_checkTranslatedStringVariable5 = verifyNot checkTranslatedStringVariable "foo=var; bar=val2; $\"foo bar\"" checkTranslatedStringVariable params (T_DollarDoubleQuoted id [T_Literal _ s]) | all isVariableChar s - && Map.member s assignments + && S.member s assignments = warnWithFix id 2256 "This translated string is the name of a variable. Flip leading $ and \" if this should be a quoted substitution." (fix id) where - assignments = foldl (flip ($)) Map.empty (map insertAssignment $ variableFlow params) - insertAssignment (Assignment (_, token, name, _)) | isVariableName name = - Map.insert name token + assignments = foldl (flip ($)) S.empty (map insertAssignment $ variableFlow params) + insertAssignment (Assignment (_, _, name, _)) | isVariableName name = + S.insert name insertAssignment _ = Prelude.id fix id = fixWith [replaceStart id params 2 "\"$"] checkTranslatedStringVariable _ _ = return () From 8746c6e7f20fdaa2463ae008dc527375ab76b04e Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 7 Jul 2024 01:07:53 -0400 Subject: [PATCH 195/244] Switch the order of the maps to avoid unnecessary unionWith instead of union --- src/ShellCheck/CFGAnalysis.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 8534d6f..27098b1 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -133,7 +133,7 @@ internalToExternal s = literalValue = Nothing } } - flatVars = M.unionsWith (\_ last -> last) $ map mapStorage [sGlobalValues s, sLocalValues s, sPrefixValues s] + flatVars = M.unions $ map mapStorage [sPrefixValues s, sLocalValues s, sGlobalValues s] -- Conveniently get the state before a token id getIncomingState :: CFGAnalysis -> Id -> Maybe ProgramState @@ -672,7 +672,7 @@ vmPatch base diff = _ | vmIsQuickEqual base diff -> diff _ -> VersionedMap { mapVersion = -1, - mapStorage = M.unionWith (flip const) (mapStorage base) (mapStorage diff) + mapStorage = M.union (mapStorage diff) (mapStorage base) } -- Set a variable. This includes properties. Applies it to the appropriate scope. @@ -1373,7 +1373,7 @@ analyzeControlFlow params t = -- Fill in the map with unreachable states for anything we didn't get to let baseStates = M.fromDistinctAscList $ map (\c -> (c, (unreachableState, unreachableState))) $ uncurry enumFromTo $ nodeRange $ cfGraph cfg - let allStates = M.unionWith (flip const) baseStates invokedStates + let allStates = M.union invokedStates baseStates -- Convert to external states let nodeToData = M.map (\(a,b) -> (internalToExternal a, internalToExternal b)) allStates From e5fdec970ae3bc16369b3ec289a4c4fbb9254751 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 7 Jul 2024 01:08:18 -0400 Subject: [PATCH 196/244] Swap the order of the tuple returned by orderEdge --- src/ShellCheck/CFG.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index e1d3259..a720911 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -300,13 +300,13 @@ removeUnnecessaryStructuralNodes (nodes, edges, mapping, association) = edgesToCollapse = S.fromList $ filter filterEdges regularEdges remapping :: M.Map Node Node - remapping = foldl' (\m (new, old) -> M.insert old new m) M.empty $ map orderEdge $ S.toList edgesToCollapse + remapping = foldl' (\m (old, new) -> M.insert old new m) M.empty $ map orderEdge $ S.toList edgesToCollapse recursiveRemapping = M.fromList $ map (\c -> (c, recursiveLookup remapping c)) $ M.keys remapping filterEdges (a,b,_) = a `S.member` candidateNodes && b `S.member` candidateNodes - orderEdge (a,b,_) = if a < b then (a,b) else (b,a) + orderEdge (a,b,_) = if a < b then (b,a) else (a,b) counter = foldl' (\map key -> M.insertWith (+) key 1 map) M.empty isRegularEdge (_, _, CFEFlow) = True isRegularEdge _ = False From 95c0cc2e4bdbad193ba3616a5ecfd2741b1f3807 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 7 Jul 2024 01:09:17 -0400 Subject: [PATCH 197/244] Simplify removeUnnecessaryStructuralNodes --- src/ShellCheck/CFG.hs | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index a720911..dc56b58 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -295,19 +295,19 @@ removeUnnecessaryStructuralNodes (nodes, edges, mapping, association) = regularEdges = filter isRegularEdge edges inDegree = counter $ map (\(from,to,_) -> from) regularEdges outDegree = counter $ map (\(from,to,_) -> to) regularEdges - structuralNodes = S.fromList $ map fst $ filter isStructural nodes + structuralNodes = S.fromList [node | (node, CFStructuralNode) <- nodes] candidateNodes = S.filter isLinear structuralNodes edgesToCollapse = S.fromList $ filter filterEdges regularEdges remapping :: M.Map Node Node - remapping = foldl' (\m (old, new) -> M.insert old new m) M.empty $ map orderEdge $ S.toList edgesToCollapse - recursiveRemapping = M.fromList $ map (\c -> (c, recursiveLookup remapping c)) $ M.keys remapping + remapping = M.fromList $ map orderEdge $ S.toList edgesToCollapse + recursiveRemapping = M.mapWithKey (\c _ -> recursiveLookup remapping c) remapping filterEdges (a,b,_) = a `S.member` candidateNodes && b `S.member` candidateNodes orderEdge (a,b,_) = if a < b then (b,a) else (a,b) - counter = foldl' (\map key -> M.insertWith (+) key 1 map) M.empty + counter = M.fromListWith (+) . map (\key -> (key, 1)) isRegularEdge (_, _, CFEFlow) = True isRegularEdge _ = False @@ -317,11 +317,6 @@ removeUnnecessaryStructuralNodes (nodes, edges, mapping, association) = Nothing -> node Just x -> recursiveLookup map x - isStructural (node, label) = - case label of - CFStructuralNode -> True - _ -> False - isLinear node = M.findWithDefault 0 node inDegree == 1 && M.findWithDefault 0 node outDegree == 1 From 98b8dc0720148d69ff924f89966c50dc2dda2fe3 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Sun, 7 Jul 2024 01:11:00 -0400 Subject: [PATCH 198/244] Use fromList instead of reimplementing it in terms of foldl --- src/ShellCheck/Analytics.hs | 20 ++++---------------- src/ShellCheck/CFGAnalysis.hs | 2 +- 2 files changed, 5 insertions(+), 17 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 621f70a..211993c 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -496,10 +496,7 @@ checkWrongArithmeticAssignment params (T_SimpleCommand id [T_Assignment _ _ _ _ "Use $((..)) for arithmetics, e.g. i=$((i " ++ op ++ " 2))" where regex = mkRegex "^([_a-zA-Z][_a-zA-Z0-9]*)([+*-]).+$" - references = foldl (flip ($)) S.empty (map insertRef $ variableFlow params) - insertRef (Assignment (_, _, name, _)) = - S.insert name - insertRef _ = Prelude.id + references = S.fromList [name | Assignment (_, _, name, _) <- variableFlow params] getNormalString (T_NormalWord _ words) = do parts <- mapM getLiterals words @@ -2380,15 +2377,9 @@ prop_checkUnused51 = verifyTree checkUnusedAssignments "x[y[z=1]]=1; echo ${x[@] checkUnusedAssignments params t = execWriter (mapM_ warnFor unused) where flow = variableFlow params - references = foldl (flip ($)) defaultMap (map insertRef flow) - insertRef (Reference (base, token, name)) = - Map.insert (stripSuffix name) () - insertRef _ = id + references = Map.union (Map.fromList [(stripSuffix name, ()) | Reference (base, token, name) <- flow]) defaultMap - assignments = foldl (flip ($)) Map.empty (map insertAssignment flow) - insertAssignment (Assignment (_, token, name, _)) | isVariableName name = - Map.insert name token - insertAssignment _ = id + assignments = Map.fromList [(name, token) | Assignment (_, token, name, _) <- flow, isVariableName name] unused = Map.assocs $ Map.difference assignments references @@ -3971,10 +3962,7 @@ checkTranslatedStringVariable params (T_DollarDoubleQuoted id [T_Literal _ s]) && S.member s assignments = warnWithFix id 2256 "This translated string is the name of a variable. Flip leading $ and \" if this should be a quoted substitution." (fix id) where - assignments = foldl (flip ($)) S.empty (map insertAssignment $ variableFlow params) - insertAssignment (Assignment (_, _, name, _)) | isVariableName name = - S.insert name - insertAssignment _ = Prelude.id + assignments = S.fromList [name | Assignment (_, _, name, _) <- variableFlow params, isVariableName name] fix id = fixWith [replaceStart id params 2 "\"$"] checkTranslatedStringVariable _ _ = return () diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 27098b1..cf982e0 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -1286,7 +1286,7 @@ dataflow ctx entry = do else do let (next, rest) = S.deleteFindMin ps nexts <- process states next - writeSTRef pending $ foldl (flip S.insert) rest nexts + writeSTRef pending $ S.union (S.fromList nexts) rest f (n-1) pending states process states node = do From 6593096ba06e6b54ec08d00a9c625930a357cdfe Mon Sep 17 00:00:00 2001 From: Sertonix Date: Fri, 28 Jun 2024 16:24:06 +0200 Subject: [PATCH 199/244] Allow SC3003 on busybox shell --- src/ShellCheck/Checks/ShellSupport.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index cab0546..9192c0e 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -212,6 +212,8 @@ prop_checkBashisms118 = verify checkBashisms "#!/bin/busybox sh\nxyz=1\n${!x*}" prop_checkBashisms119 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${x^^[t]}" -- SC3059 prop_checkBashisms120 = verify checkBashisms "#!/bin/sh\n[ x == y ]" prop_checkBashisms121 = verifyNot checkBashisms "#!/bin/sh\n# shellcheck shell=busybox\n[ x == y ]" +prop_checkBashisms122 = verify checkBashisms "#!/bin/dash\n$'a'" +prop_checkBashisms123 = verifyNot checkBashisms "#!/bin/busybox sh\n$'a'" checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t @@ -229,7 +231,8 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do bashism (T_ProcSub id _ _) = warnMsg id 3001 "process substitution is" bashism (T_Extglob id _ _) = warnMsg id 3002 "extglob is" - bashism (T_DollarSingleQuoted id _) = warnMsg id 3003 "$'..' is" + bashism (T_DollarSingleQuoted id _) = + unless isBusyboxSh $ warnMsg id 3003 "$'..' is" bashism (T_DollarDoubleQuoted id _) = warnMsg id 3004 "$\"..\" is" bashism (T_ForArithmetic id _ _ _ _) = warnMsg id 3005 "arithmetic for loops are" bashism (T_Arithmetic id _) = warnMsg id 3006 "standalone ((..)) is" From 4c852749214e102f7a1daec08094ed91b08867f7 Mon Sep 17 00:00:00 2001 From: Sertonix Date: Tue, 2 Jul 2024 17:06:35 +0200 Subject: [PATCH 200/244] Fix SC3045 for busybox shell --- src/ShellCheck/Checks/ShellSupport.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 9192c0e..1207ad0 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -214,6 +214,9 @@ prop_checkBashisms120 = verify checkBashisms "#!/bin/sh\n[ x == y ]" prop_checkBashisms121 = verifyNot checkBashisms "#!/bin/sh\n# shellcheck shell=busybox\n[ x == y ]" prop_checkBashisms122 = verify checkBashisms "#!/bin/dash\n$'a'" prop_checkBashisms123 = verifyNot checkBashisms "#!/bin/busybox sh\n$'a'" +prop_checkBashisms124 = verify checkBashisms "#!/bin/dash\ntype -p test" +prop_checkBashisms125 = verifyNot checkBashisms "#!/bin/busybox sh\ntype -p test" +prop_checkBashisms126 = verifyNot checkBashisms "#!/bin/busybox sh\nread -p foo -r bar" checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t @@ -446,10 +449,10 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do ("hash", Just $ if isDash then ["r", "v"] else ["r"]), ("jobs", Just ["l", "p"]), ("printf", Just []), - ("read", Just $ if isDash then ["r", "p"] else ["r"]), + ("read", Just $ if isDash || isBusyboxSh then ["r", "p"] else ["r"]), ("readonly", Just ["p"]), ("trap", Just []), - ("type", Just []), + ("type", Just $ if isBusyboxSh then ["p"] else []), ("ulimit", if isDash then Nothing else Just ["f"]), ("umask", Just ["S"]), ("unset", Just ["f", "v"]), From 6d2f3d8628235dd2146cd248d9828b004852c7ad Mon Sep 17 00:00:00 2001 From: Sertonix Date: Tue, 9 Jul 2024 15:12:16 +0200 Subject: [PATCH 201/244] Allow 'echo -e' in busybox shell --- src/ShellCheck/Checks/ShellSupport.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 1207ad0..2ec4cf7 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -217,6 +217,7 @@ prop_checkBashisms123 = verifyNot checkBashisms "#!/bin/busybox sh\n$'a'" prop_checkBashisms124 = verify checkBashisms "#!/bin/dash\ntype -p test" prop_checkBashisms125 = verifyNot checkBashisms "#!/bin/busybox sh\ntype -p test" prop_checkBashisms126 = verifyNot checkBashisms "#!/bin/busybox sh\nread -p foo -r bar" +prop_checkBashisms127 = verifyNot checkBashisms "#!/bin/busybox sh\necho -ne foo" checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t @@ -327,7 +328,11 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do bashism t@(T_SimpleCommand _ _ (cmd:arg:_)) | t `isCommand` "echo" && argString `matches` flagRegex = - if isDash + if isBusyboxSh + then + when (not (argString `matches` busyboxFlagRegex)) $ + warnMsg (getId arg) 3036 "echo flags besides -n and -e" + else if isDash then when (argString /= "-n") $ warnMsg (getId arg) 3036 "echo flags besides -n" @@ -336,6 +341,7 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do where argString = concat $ oversimplify arg flagRegex = mkRegex "^-[eEsn]+$" + busyboxFlagRegex = mkRegex "^-[en]+$" bashism t@(T_SimpleCommand _ _ (cmd:arg:_)) | getLiteralString cmd == Just "exec" && "-" `isPrefixOf` concat (oversimplify arg) = From d590a35ff8093a3a1edeac67cdb7fb9cffa593bf Mon Sep 17 00:00:00 2001 From: Hasit Mistry Date: Tue, 9 Jul 2024 14:22:19 -0700 Subject: [PATCH 202/244] Update README.md --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index 366c427..03d4d4a 100644 --- a/README.md +++ b/README.md @@ -113,6 +113,7 @@ Services and platforms that have ShellCheck pre-installed and ready to use: * [CircleCI](https://circleci.com) via the [ShellCheck Orb](https://circleci.com/orbs/registry/orb/circleci/shellcheck) * [Github](https://github.com/features/actions) (only Linux) * [Trunk Check](https://trunk.io/products/check) (universal linter; [allows you to explicitly version your shellcheck install](https://github.com/trunk-io/plugins/blob/bcbb361dcdbe4619af51ea7db474d7fb87540d20/.trunk/trunk.yaml#L32)) via the [shellcheck plugin](https://github.com/trunk-io/plugins/blob/main/linters/shellcheck/plugin.yaml) +* [CodeRabbit](https://coderabbit.ai/) Most other services, including [GitLab](https://about.gitlab.com/), let you install ShellCheck yourself, either through the system's package manager (see [Installing](#installing)), From 2696c6472dd55880f4dc1350262e1192953754ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Santoro?= Date: Wed, 31 Jul 2024 12:52:42 +0000 Subject: [PATCH 203/244] Whitelist oc to avoid SC2016 false positive Fixes #3033. --- src/ShellCheck/Analytics.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 211993c..08eed57 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1097,6 +1097,7 @@ checkSingleQuotedVariables params t@(T_SingleQuoted id s) = ,"sudo" -- covering "sudo sh" and such ,"docker" -- like above ,"podman" + ,"oc" ,"dpkg-query" ,"jq" -- could also check that user provides --arg ,"rename" From 38c5ba7c79e35af29bb1496e774af1d5add0e73c Mon Sep 17 00:00:00 2001 From: Emil Berg Date: Sat, 3 Aug 2024 08:49:40 +0200 Subject: [PATCH 204/244] Fix typos and trailing whitespace --- .github/ISSUE_TEMPLATE.md | 4 ++-- README.md | 2 +- src/ShellCheck/AST.hs | 4 ++-- src/ShellCheck/Analytics.hs | 6 +++--- src/ShellCheck/CFG.hs | 2 +- src/ShellCheck/Checks/Custom.hs | 2 +- src/ShellCheck/Parser.hs | 2 +- 7 files changed, 11 insertions(+), 11 deletions(-) diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md index 44d151e..493b465 100644 --- a/.github/ISSUE_TEMPLATE.md +++ b/.github/ISSUE_TEMPLATE.md @@ -1,6 +1,6 @@ #### For bugs -- Rule Id (if any, e.g. SC1000): -- My shellcheck version (`shellcheck --version` or "online"): +- Rule Id (if any, e.g. SC1000): +- My shellcheck version (`shellcheck --version` or "online"): - [ ] The rule's wiki page does not already cover this (e.g. https://shellcheck.net/wiki/SC2086) - [ ] I tried on https://www.shellcheck.net/ and verified that this is still a problem on the latest commit diff --git a/README.md b/README.md index 366c427..78802a0 100644 --- a/README.md +++ b/README.md @@ -233,7 +233,7 @@ Alternatively, you can download pre-compiled binaries for the latest release her * [Linux, x86_64](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.linux.x86_64.tar.xz) (statically linked) * [Linux, armv6hf](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.linux.armv6hf.tar.xz), i.e. Raspberry Pi (statically linked) * [Linux, aarch64](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.linux.aarch64.tar.xz) aka ARM64 (statically linked) -* [macOS, aarch64](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.darwin.aarch64.tar.xz) +* [macOS, aarch64](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.darwin.aarch64.tar.xz) * [macOS, x86_64](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.darwin.x86_64.tar.xz) * [Windows, x86](https://github.com/koalaman/shellcheck/releases/download/stable/shellcheck-stable.zip) diff --git a/src/ShellCheck/AST.hs b/src/ShellCheck/AST.hs index ca05c98..979a9b0 100644 --- a/src/ShellCheck/AST.hs +++ b/src/ShellCheck/AST.hs @@ -206,7 +206,7 @@ pattern T_Annotation id anns t = OuterToken id (Inner_T_Annotation anns t) pattern T_Arithmetic id c = OuterToken id (Inner_T_Arithmetic c) pattern T_Array id t = OuterToken id (Inner_T_Array t) pattern TA_Sequence id l = OuterToken id (Inner_TA_Sequence l) -pattern TA_Parentesis id t = OuterToken id (Inner_TA_Parenthesis t) +pattern TA_Parenthesis id t = OuterToken id (Inner_TA_Parenthesis t) pattern T_Assignment id mode var indices value = OuterToken id (Inner_T_Assignment mode var indices value) pattern TA_Trinary id t1 t2 t3 = OuterToken id (Inner_TA_Trinary t1 t2 t3) pattern TA_Unary id op t1 = OuterToken id (Inner_TA_Unary op t1) @@ -259,7 +259,7 @@ pattern T_Subshell id l = OuterToken id (Inner_T_Subshell l) pattern T_UntilExpression id c l = OuterToken id (Inner_T_UntilExpression c l) pattern T_WhileExpression id c l = OuterToken id (Inner_T_WhileExpression c l) -{-# COMPLETE T_AND_IF, T_Bang, T_Case, TC_Empty, T_CLOBBER, T_DGREAT, T_DLESS, T_DLESSDASH, T_Do, T_DollarSingleQuoted, T_Done, T_DSEMI, T_Elif, T_Else, T_EOF, T_Esac, T_Fi, T_For, T_Glob, T_GREATAND, T_Greater, T_If, T_In, T_Lbrace, T_Less, T_LESSAND, T_LESSGREAT, T_Literal, T_Lparen, T_NEWLINE, T_OR_IF, T_ParamSubSpecialChar, T_Pipe, T_Rbrace, T_Rparen, T_Select, T_Semi, T_SingleQuoted, T_Then, T_UnparsedIndex, T_Until, T_While, TA_Assignment, TA_Binary, TA_Expansion, T_AndIf, T_Annotation, T_Arithmetic, T_Array, TA_Sequence, TA_Parentesis, T_Assignment, TA_Trinary, TA_Unary, TA_Variable, T_Backgrounded, T_Backticked, T_Banged, T_BatsTest, T_BraceExpansion, T_BraceGroup, TC_And, T_CaseExpression, TC_Binary, TC_Group, TC_Nullary, T_Condition, T_CoProcBody, T_CoProc, TC_Or, TC_Unary, T_DollarArithmetic, T_DollarBraceCommandExpansion, T_DollarBraced, T_DollarBracket, T_DollarDoubleQuoted, T_DollarExpansion, T_DoubleQuoted, T_Extglob, T_FdRedirect, T_ForArithmetic, T_ForIn, T_Function, T_HereDoc, T_HereString, T_IfExpression, T_Include, T_IndexedElement, T_IoDuplicate, T_IoFile, T_NormalWord, T_OrIf, T_Pipeline, T_ProcSub, T_Redirecting, T_Script, T_SelectIn, T_SimpleCommand, T_SourceCommand, T_Subshell, T_UntilExpression, T_WhileExpression #-} +{-# COMPLETE T_AND_IF, T_Bang, T_Case, TC_Empty, T_CLOBBER, T_DGREAT, T_DLESS, T_DLESSDASH, T_Do, T_DollarSingleQuoted, T_Done, T_DSEMI, T_Elif, T_Else, T_EOF, T_Esac, T_Fi, T_For, T_Glob, T_GREATAND, T_Greater, T_If, T_In, T_Lbrace, T_Less, T_LESSAND, T_LESSGREAT, T_Literal, T_Lparen, T_NEWLINE, T_OR_IF, T_ParamSubSpecialChar, T_Pipe, T_Rbrace, T_Rparen, T_Select, T_Semi, T_SingleQuoted, T_Then, T_UnparsedIndex, T_Until, T_While, TA_Assignment, TA_Binary, TA_Expansion, T_AndIf, T_Annotation, T_Arithmetic, T_Array, TA_Sequence, TA_Parenthesis, T_Assignment, TA_Trinary, TA_Unary, TA_Variable, T_Backgrounded, T_Backticked, T_Banged, T_BatsTest, T_BraceExpansion, T_BraceGroup, TC_And, T_CaseExpression, TC_Binary, TC_Group, TC_Nullary, T_Condition, T_CoProcBody, T_CoProc, TC_Or, TC_Unary, T_DollarArithmetic, T_DollarBraceCommandExpansion, T_DollarBraced, T_DollarBracket, T_DollarDoubleQuoted, T_DollarExpansion, T_DoubleQuoted, T_Extglob, T_FdRedirect, T_ForArithmetic, T_ForIn, T_Function, T_HereDoc, T_HereString, T_IfExpression, T_Include, T_IndexedElement, T_IoDuplicate, T_IoFile, T_NormalWord, T_OrIf, T_Pipeline, T_ProcSub, T_Redirecting, T_Script, T_SelectIn, T_SimpleCommand, T_SourceCommand, T_Subshell, T_UntilExpression, T_WhileExpression #-} instance Eq Token where OuterToken _ a == OuterToken _ b = a == b diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 211993c..b3d673f 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -3294,7 +3294,7 @@ checkReturnAgainstZero params token = next@(TA_Unary _ "!" _):_ -> isOnlyTestInCommand next next@(TC_Group {}):_ -> isOnlyTestInCommand next next@(TA_Sequence _ [_]):_ -> isOnlyTestInCommand next - next@(TA_Parentesis _ _):_ -> isOnlyTestInCommand next + next@(TA_Parenthesis _ _):_ -> isOnlyTestInCommand next _ -> False -- TODO: Do better $? tracking and filter on whether @@ -4990,14 +4990,14 @@ checkUnnecessaryParens params t = T_ForArithmetic _ x y z _ -> mapM_ (checkLeading "for (((x); (y); (z))) is the same as for ((x; y; z))") [x,y,z] T_Assignment _ _ _ [t] _ -> checkLeading "a[(x)] is the same as a[x]" t T_Arithmetic _ t -> checkLeading "(( (x) )) is the same as (( x ))" t - TA_Parentesis _ (TA_Sequence _ [ TA_Parentesis id _ ]) -> + TA_Parenthesis _ (TA_Sequence _ [ TA_Parenthesis id _ ]) -> styleWithFix id 2322 "In arithmetic contexts, ((x)) is the same as (x). Prefer only one layer of parentheses." $ fix id _ -> return () where checkLeading str t = case t of - TA_Sequence _ [TA_Parentesis id _ ] -> styleWithFix id 2323 (str ++ ". Prefer not wrapping in additional parentheses.") $ fix id + TA_Sequence _ [TA_Parenthesis id _ ] -> styleWithFix id 2323 (str ++ ". Prefer not wrapping in additional parentheses.") $ fix id _ -> return () fix id = diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index dc56b58..81689a1 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -490,7 +490,7 @@ build t = do TA_Binary _ _ a b -> sequentially [a,b] TA_Expansion _ list -> sequentially list TA_Sequence _ list -> sequentially list - TA_Parentesis _ t -> build t + TA_Parenthesis _ t -> build t TA_Trinary _ cond a b -> do condition <- build cond diff --git a/src/ShellCheck/Checks/Custom.hs b/src/ShellCheck/Checks/Custom.hs index 76ac83c..17e9c9e 100644 --- a/src/ShellCheck/Checks/Custom.hs +++ b/src/ShellCheck/Checks/Custom.hs @@ -1,7 +1,7 @@ {- This empty file is provided for ease of patching in site specific checks. However, there are no guarantees regarding compatibility between versions. --} +-} {-# LANGUAGE TemplateHaskell #-} module ShellCheck.Checks.Custom (checker, ShellCheck.Checks.Custom.runTests) where diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 9cc5e02..dfe3131 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -827,7 +827,7 @@ readArithmeticContents = char ')' id <- endSpan start spacing - return $ TA_Parentesis id s + return $ TA_Parenthesis id s readArithTerm = readGroup <|> readVariable <|> readExpansion From c7611dfcc6ccb320b530a4e9179e6facee96a422 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 19 Aug 2024 18:37:29 -0700 Subject: [PATCH 205/244] Use dynamic artifact name to work around issue with v4 uploader --- .github/workflows/build.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 8f9d7d0..3886655 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -65,7 +65,7 @@ jobs: - name: Upload artifact uses: actions/upload-artifact@v4 with: - name: bin + name: ${{matrix.build}}.bin path: bin/ package_binary: From 68e6f02267defb1e2e6398b0f477b4b85e930c22 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 31 Aug 2024 18:00:49 -0700 Subject: [PATCH 206/244] Expand list of recognized unicode spaces (and rewrite for performance) --- src/ShellCheck/Parser.hs | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index dfe3131..3de3537 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -141,15 +141,9 @@ carriageReturn = do parseProblemAt pos ErrorC 1017 "Literal carriage return. Run script through tr -d '\\r' ." return '\r' -almostSpace = - choice [ - check '\xA0' "unicode non-breaking space", - check '\x200B' "unicode zerowidth space" - ] - where - check c name = do - parseNote ErrorC 1018 $ "This is a " ++ name ++ ". Delete and retype it." - char c +almostSpace = do + parseNote ErrorC 1018 $ "This is a unicode space. Delete and retype it." + oneOf "\xA0\x2002\x2003\x2004\x2005\x2006\x2007\x2008\x2009\x200B\x202F" return ' ' --------- Message/position annotation on top of user state From 1487e57a46a48f926f0cd698756cfe41d9635c15 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 31 Aug 2024 18:27:18 -0700 Subject: [PATCH 207/244] Suppress unused warnings about stderr and stderr_lines from bats tests, fixing tests. --- src/ShellCheck/Data.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 917142e..3000a99 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -62,6 +62,9 @@ internalVariables = [ , "FLAGS_ARGC", "FLAGS_ARGV", "FLAGS_ERROR", "FLAGS_FALSE", "FLAGS_HELP", "FLAGS_PARENT", "FLAGS_RESERVED", "FLAGS_TRUE", "FLAGS_VERSION", "flags_error", "flags_return" + + -- Bats + ,"stderr", "stderr_lines" ] specialIntegerVariables = [ From 88e441453ba3bbb2aa0449dc178b8f82aaee5b4c Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 31 Aug 2024 18:31:47 -0700 Subject: [PATCH 208/244] Make SC2002 optional (useless-use-of-cat) --- src/ShellCheck/Analytics.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 869b683..ce11884 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -103,8 +103,7 @@ nodeChecksToTreeCheck checkList = nodeChecks :: [Parameters -> Token -> Writer [TokenComment] ()] nodeChecks = [ - checkUuoc - ,checkPipePitfalls + checkPipePitfalls ,checkForInQuoted ,checkForInLs ,checkShorthandIf @@ -273,6 +272,13 @@ optionalTreeChecks = [ cdPositive = "rm -r \"$(get_chroot_dir)/home\"", cdNegative = "set -e; dir=\"$(get_chroot_dir)\"; rm -r \"$dir/home\"" }, checkExtraMaskedReturns) + + ,(newCheckDescription { + cdName = "useless-use-of-cat", + cdDescription = "Check for Useless Use Of Cat (UUOC)", + cdPositive = "cat foo | grep bar", + cdNegative = "grep bar foo" + }, nodeChecksToTreeCheck [checkUuoc]) ] optionalCheckMap :: Map.Map String (Parameters -> Token -> [TokenComment]) From 8a1b24c7afcd0534e15eb7db8e386d0d550c6015 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 1 Sep 2024 13:21:44 -0700 Subject: [PATCH 209/244] Fix paths for CI binary packaging after upgrade --- .github/workflows/build.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 3886655..b0d1085 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -43,7 +43,7 @@ jobs: path: source/ build_source: - name: Build Source Code + name: Build needs: package_source strategy: matrix: @@ -80,13 +80,13 @@ jobs: uses: actions/download-artifact@v4 - name: Work around GitHub permissions bug - run: chmod +x bin/*/shellcheck* + run: chmod +x *.bin/*/shellcheck* - name: Package binaries run: | export TAGS="$(cat source/tags)" mkdir -p deploy - cp -r bin/* deploy + cp -r *.bin/* deploy cd deploy ../.prepare_deploy rm -rf */ README* LICENSE* From ca65071d778d140bc6bad64e699265dde25821e9 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 1 Sep 2024 14:06:26 -0700 Subject: [PATCH 210/244] Run unit tests in GitHub actions --- .github/workflows/build.yml | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index b0d1085..83269c9 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -42,6 +42,29 @@ jobs: name: source path: source/ + run_tests: + name: Run tests + needs: package_source + runs-on: ubuntu-latest + steps: + - name: Download artifacts + uses: actions/download-artifact@v4 + + - name: Install dependencies + run: | + sudo apt-get update && sudo apt-get install ghc cabal-install + cabal update + + - name: Unpack source + run: | + cd source + tar xvf source.tar.gz --strip-components=1 + + - name: Build and run tests + run: | + cd source + cabal test + build_source: name: Build needs: package_source From 79e43c4550aaf50ebcced1c2b2852f1bd2533f6c Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 7 Sep 2024 17:14:52 -0700 Subject: [PATCH 211/244] Allow parsing arbitrary coproc names (fixes #3048) --- src/ShellCheck/AST.hs | 2 +- src/ShellCheck/AnalyzerLib.hs | 8 ++++++-- src/ShellCheck/CFG.hs | 14 +++++++++++--- src/ShellCheck/Parser.hs | 35 ++++++++++++++++++++++++++++------- 4 files changed, 46 insertions(+), 13 deletions(-) diff --git a/src/ShellCheck/AST.hs b/src/ShellCheck/AST.hs index 979a9b0..bafe035 100644 --- a/src/ShellCheck/AST.hs +++ b/src/ShellCheck/AST.hs @@ -138,7 +138,7 @@ data InnerToken t = | Inner_T_WhileExpression [t] [t] | Inner_T_Annotation [Annotation] t | Inner_T_Pipe String - | Inner_T_CoProc (Maybe String) t + | Inner_T_CoProc (Maybe Token) t | Inner_T_CoProcBody t | Inner_T_Include t | Inner_T_SourceCommand t t diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 3b1faa9..531ce8b 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -559,8 +559,12 @@ getModifiedVariables t = T_FdRedirect _ ('{':var) op -> -- {foo}>&2 modifies foo [(t, t, takeWhile (/= '}') var, DataString SourceInteger) | not $ isClosingFileOp op] - T_CoProc _ name _ -> - [(t, t, fromMaybe "COPROC" name, DataArray SourceInteger)] + T_CoProc _ Nothing _ -> + [(t, t, "COPROC", DataArray SourceInteger)] + + T_CoProc _ (Just token) _ -> do + name <- maybeToList $ getLiteralString token + [(t, t, name, DataArray SourceInteger)] --Points to 'for' rather than variable T_ForIn id str [] _ -> [(t, t, str, DataString SourceExternal)] diff --git a/src/ShellCheck/CFG.hs b/src/ShellCheck/CFG.hs index 81689a1..57aaf4b 100644 --- a/src/ShellCheck/CFG.hs +++ b/src/ShellCheck/CFG.hs @@ -668,10 +668,18 @@ build t = do status <- newNodeRange $ CFSetExitCode id linkRange cond status - T_CoProc id maybeName t -> do - let name = fromMaybe "COPROC" maybeName + T_CoProc id maybeNameToken t -> do + -- If unspecified, "COPROC". If not a constant string, Nothing. + let maybeName = case maybeNameToken of + Just x -> getLiteralString x + Nothing -> Just "COPROC" + + let parentNode = case maybeName of + Just str -> applySingle $ IdTagged id $ CFWriteVariable str CFValueArray + Nothing -> CFStructuralNode + start <- newStructuralNode - parent <- newNodeRange $ applySingle $ IdTagged id $ CFWriteVariable name CFValueArray + parent <- newNodeRange parentNode child <- subshell id "coproc" $ build t end <- newNodeRange $ CFSetExitCode id diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 3de3537..66d62ff 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -2795,17 +2795,29 @@ readFunctionDefinition = called "function" $ do prop_readCoProc1 = isOk readCoProc "coproc foo { echo bar; }" prop_readCoProc2 = isOk readCoProc "coproc { echo bar; }" prop_readCoProc3 = isOk readCoProc "coproc echo bar" +prop_readCoProc4 = isOk readCoProc "coproc a=b echo bar" +prop_readCoProc5 = isOk readCoProc "coproc 'foo' { echo bar; }" +prop_readCoProc6 = isOk readCoProc "coproc \"foo$$\" { echo bar; }" +prop_readCoProc7 = isOk readCoProc "coproc 'foo' ( echo bar )" +prop_readCoProc8 = isOk readCoProc "coproc \"foo$$\" while true; do true; done" readCoProc = called "coproc" $ do start <- startSpan try $ do string "coproc" - whitespace + spacing1 choice [ try $ readCompoundCoProc start, readSimpleCoProc start ] where readCompoundCoProc start = do - var <- optionMaybe $ - readVariableName `thenSkip` whitespace - body <- readBody readCompoundCommand + notFollowedBy2 readAssignmentWord + (var, body) <- choice [ + try $ do + body <- readBody readCompoundCommand + return (Nothing, body), + try $ do + var <- readNormalWord `thenSkip` spacing + body <- readBody readCompoundCommand + return (Just var, body) + ] id <- endSpan start return $ T_CoProc id var body readSimpleCoProc start = do @@ -3436,13 +3448,22 @@ isOk p s = parsesCleanly p s == Just True -- The string parses with no wa isWarning p s = parsesCleanly p s == Just False -- The string parses with warnings isNotOk p s = parsesCleanly p s == Nothing -- The string does not parse -parsesCleanly parser string = runIdentity $ do +-- If the parser matches the string, return Right [ParseNotes+ParseProblems] +-- If it does not match the string, return Left [ParseProblems] +getParseOutput parser string = runIdentity $ do (res, sys) <- runParser testEnvironment (parser >> eof >> getState) "-" string case (res, sys) of (Right userState, systemState) -> - return $ Just . null $ parseNotes userState ++ parseProblems systemState - (Left _, _) -> return Nothing + return $ Right $ parseNotes userState ++ parseProblems systemState + (Left _, systemState) -> return $ Left $ parseProblems systemState + +-- If the parser matches the string, return Just whether it was clean (without emitting suggestions) +-- Otherwise, Nothing +parsesCleanly parser string = + case getParseOutput parser string of + Right list -> Just $ null list + Left _ -> Nothing parseWithNotes parser = do item <- parser From 5c2be767abff85fd10325a2d8a61a372567e63b8 Mon Sep 17 00:00:00 2001 From: Tony <3987237+random1223@users.noreply.github.com> Date: Mon, 9 Sep 2024 18:56:18 -0700 Subject: [PATCH 212/244] Update README.md Add Codety Scanner into the static analysis solution list. Here are the examples of the result: * Codety's pull request code review example: https://github.com/codetyio/codety-scanner/pull/66#issuecomment-2339438925 * Codety's GitHub code scan result example : https://github.com/codetyio/codety-scanner/runs/29907371258 Codety Scanner is open source: https://github.com/codetyio/codety-scanner --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index c200a3e..9b776cf 100644 --- a/README.md +++ b/README.md @@ -110,6 +110,7 @@ Services and platforms that have ShellCheck pre-installed and ready to use: * [Codacy](https://www.codacy.com/) * [Code Climate](https://codeclimate.com/) * [Code Factor](https://www.codefactor.io/) +* [Codety](https://www.codety.io/) via the [Codety Scanner](https://github.com/codetyio/codety-scanner) * [CircleCI](https://circleci.com) via the [ShellCheck Orb](https://circleci.com/orbs/registry/orb/circleci/shellcheck) * [Github](https://github.com/features/actions) (only Linux) * [Trunk Check](https://trunk.io/products/check) (universal linter; [allows you to explicitly version your shellcheck install](https://github.com/trunk-io/plugins/blob/bcbb361dcdbe4619af51ea7db474d7fb87540d20/.trunk/trunk.yaml#L32)) via the [shellcheck plugin](https://github.com/trunk-io/plugins/blob/main/linters/shellcheck/plugin.yaml) From 5e3e98bcb0ca594185e9e675dac929aa053dd223 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 27 Oct 2024 15:43:30 -0700 Subject: [PATCH 213/244] Use CFG to determine use-before-define for SC2218 (fixes #3070) --- CHANGELOG.md | 1 + src/ShellCheck/Analytics.hs | 48 ++++++++++++++++++------------------- 2 files changed, 25 insertions(+), 24 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 43db00c..982036d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,7 @@ ### Changed - SC2015 about `A && B || C` no longer triggers when B is a test command. ### Fixed +- SC2218 about function use-before-define is now more accurate. - SC2317 about unreachable commands is now less spammy for nested ones. - SC2292, optional suggestion for [[ ]], now triggers for Busybox. diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index ce11884..7f7a572 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -3765,32 +3765,32 @@ prop_checkUseBeforeDefinition1 = verifyTree checkUseBeforeDefinition "f; f() { t prop_checkUseBeforeDefinition2 = verifyNotTree checkUseBeforeDefinition "f() { true; }; f" prop_checkUseBeforeDefinition3 = verifyNotTree checkUseBeforeDefinition "if ! mycmd --version; then mycmd() { true; }; fi" prop_checkUseBeforeDefinition4 = verifyNotTree checkUseBeforeDefinition "mycmd || mycmd() { f; }" -checkUseBeforeDefinition _ t = - execWriter $ evalStateT (mapM_ examine $ revCommands) Map.empty +prop_checkUseBeforeDefinition5 = verifyTree checkUseBeforeDefinition "false || mycmd; mycmd() { f; }" +prop_checkUseBeforeDefinition6 = verifyNotTree checkUseBeforeDefinition "f() { one; }; f; f() { two; }; f" +checkUseBeforeDefinition :: Parameters -> Token -> [TokenComment] +checkUseBeforeDefinition params t = fromMaybe [] $ do + cfga <- cfgAnalysis params + let funcs = execState (doAnalysis findFunction t) Map.empty + -- Green cut: no point enumerating commands if there are no functions. + guard . not $ Map.null funcs + return $ execWriter $ doAnalysis (findInvocation cfga funcs) t where - examine t = case t of - T_Pipeline _ _ [T_Redirecting _ _ (T_Function _ _ _ name _)] -> - modify $ Map.insert name t - T_Annotation _ _ w -> examine w - T_Pipeline _ _ cmds -> do - m <- get - unless (Map.null m) $ - mapM_ (checkUsage m) $ concatMap recursiveSequences cmds - _ -> return () + findFunction t = + case t of + T_Function id _ _ name _ -> modify (Map.insertWith (++) name [id]) + _ -> return () - checkUsage map cmd = sequence_ $ do - name <- getCommandName cmd - def <- Map.lookup name map - return $ - err (getId cmd) 2218 - "This function is only defined later. Move the definition up." - - revCommands = reverse $ concat $ getCommandSequences t - recursiveSequences x = - let list = concat $ getCommandSequences x in - if null list - then [x] - else concatMap recursiveSequences list + findInvocation cfga funcs t = + case t of + T_SimpleCommand id _ (cmd:_) -> sequence_ $ do + name <- getLiteralString cmd + invocations <- Map.lookup name funcs + -- Is the function definitely being defined later? + guard $ any (\c -> CF.doesPostDominate cfga c id) invocations + -- Was one already defined, so it's actually a re-definition? + guard . not $ any (\c -> CF.doesPostDominate cfga id c) invocations + return $ err id 2218 "This function is only defined later. Move the definition up." + _ -> return () prop_checkForLoopGlobVariables1 = verify checkForLoopGlobVariables "for i in $var/*.txt; do true; done" prop_checkForLoopGlobVariables2 = verifyNot checkForLoopGlobVariables "for i in \"$var\"/*.txt; do true; done" From f2932ebcdc51527ca439737465e35b0b039a51b7 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 27 Oct 2024 16:02:56 -0700 Subject: [PATCH 214/244] Remember to add changelog to release messages (fixes #3051) --- test/check_release | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/test/check_release b/test/check_release index 665b265..f3ea9df 100755 --- a/test/check_release +++ b/test/check_release @@ -50,6 +50,11 @@ then fail "Expected git log message to be 'Stable version ...'" fi +if [[ $(git log -1 --pretty=%B) != *"CHANGELOG"* ]] +then + fail "Expected git log message to contain CHANGELOG" +fi + i=1 j=1 cat << EOF From 097018754b313a102834ec389079ee04673f68fa Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 27 Oct 2024 18:10:00 -0700 Subject: [PATCH 215/244] Mention that SC2002 (UUOC) is now no longer enabled by default. --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 982036d..612068d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,8 @@ - SC2330: Warn about unsupported glob matches with [[ .. ]] in BusyBox. - Precompiled binaries for Linux riscv64 (linux.riscv64) ### Changed +- SC2002 about Useless Use Of Cat is now disabled by default. It can be + re-enabled with `--enable=useless-use-of-cat` or equivalent directive. - SC2015 about `A && B || C` no longer triggers when B is a test command. ### Fixed - SC2218 about function use-before-define is now more accurate. From 792466bc22ea9528313b5224621610551216e4a6 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 3 Nov 2024 13:56:51 -0800 Subject: [PATCH 216/244] Update Diff dependency (fixes #3075) --- ShellCheck.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ShellCheck.cabal b/ShellCheck.cabal index fc52b12..0f604a9 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -53,7 +53,7 @@ library bytestring >= 0.10.6 && < 0.13, containers >= 0.5.6 && < 0.8, deepseq >= 1.4.1 && < 1.6, - Diff >= 0.4.0 && < 0.6, + Diff >= 0.4.0 && < 1.1, fgl (>= 5.7.0 && < 5.8.1.0) || (>= 5.8.1.1 && < 5.9), filepath >= 1.4.0 && < 1.5, mtl >= 2.2.2 && < 2.4, From 0ee46a0f33ebafde128e2c93dd45f2757de4d4ec Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 3 Nov 2024 14:19:08 -0800 Subject: [PATCH 217/244] Update filepath dependency --- ShellCheck.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ShellCheck.cabal b/ShellCheck.cabal index 0f604a9..f31ead3 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -55,7 +55,7 @@ library deepseq >= 1.4.1 && < 1.6, Diff >= 0.4.0 && < 1.1, fgl (>= 5.7.0 && < 5.8.1.0) || (>= 5.8.1.1 && < 5.9), - filepath >= 1.4.0 && < 1.5, + filepath >= 1.4.0 && < 1.6, mtl >= 2.2.2 && < 2.4, parsec >= 3.1.14 && < 3.2, QuickCheck >= 2.14.2 && < 2.15, From 47bff1d5fdc478a3bfb32ffb532d33bab0e64b2c Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 3 Nov 2024 16:54:45 -0800 Subject: [PATCH 218/244] Add 24.04 to distrotest LTS --- test/distrotest | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/distrotest b/test/distrotest index ef467b8..c52a5c9 100755 --- a/test/distrotest +++ b/test/distrotest @@ -74,11 +74,12 @@ fedora:latest dnf install -y cabal-install ghc-template-haskell-devel fi archlinux:latest pacman -S -y --noconfirm cabal-install ghc-static base-devel # Ubuntu LTS +ubuntu:24.04 apt-get update && apt-get install -y cabal-install ubuntu:22.04 apt-get update && apt-get install -y cabal-install ubuntu:20.04 apt-get update && apt-get install -y cabal-install # Stack on Ubuntu LTS -ubuntu:22.04 set -e; apt-get update && apt-get install -y curl && curl -sSL https://get.haskellstack.org/ | sh -s - -f && cd /mnt && exec test/stacktest +ubuntu:24.04 set -e; apt-get update && apt-get install -y curl && curl -sSL https://get.haskellstack.org/ | sh -s - -f && cd /mnt && exec test/stacktest EOF exit "$final" From 944d87915a191af442b3895ef5af89ffb65789d8 Mon Sep 17 00:00:00 2001 From: Evan Silberman Date: Mon, 11 Nov 2024 11:24:21 -0800 Subject: [PATCH 219/244] Recognize "oksh" executable name as ksh A portable version of OpenBSD's ksh is distributed with the executable name oksh [1]. It's a descendant of pdksh and can be shellchecked as ksh. [1]: https://github.com/ibara/oksh --- src/ShellCheck/Data.hs | 1 + src/ShellCheck/Parser.hs | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 3000a99..a145684 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -167,6 +167,7 @@ shellForExecutable name = "ksh" -> return Ksh "ksh88" -> return Ksh "ksh93" -> return Ksh + "oksh" -> return Ksh _ -> Nothing flagsForRead = "sreu:n:N:i:p:a:t:" diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 66d62ff..3986dab 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -3387,7 +3387,8 @@ readScriptFile sourced = do "busybox sh", "bash", "bats", - "ksh" + "ksh", + "oksh" ] badShells = [ "awk", From 7f3f014d49d4bc6b979ed5508b1c57874e795ee8 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 28 Nov 2024 11:51:22 -0800 Subject: [PATCH 220/244] Allow latest QuickCheck --- ShellCheck.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ShellCheck.cabal b/ShellCheck.cabal index f31ead3..68c32d9 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -58,7 +58,7 @@ library filepath >= 1.4.0 && < 1.6, mtl >= 2.2.2 && < 2.4, parsec >= 3.1.14 && < 3.2, - QuickCheck >= 2.14.2 && < 2.15, + QuickCheck >= 2.14.2 && < 2.16, regex-tdfa >= 1.2.0 && < 1.4, transformers >= 0.4.2 && < 0.7, From 3c75d82db571aa3fd337e04077daa3c01e0c878e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 29 Nov 2024 12:58:56 -0800 Subject: [PATCH 221/244] Fix stacktest complaining about permissions on /mnt --- test/distrotest | 6 +++--- test/stacktest | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/test/distrotest b/test/distrotest index c52a5c9..128ee44 100755 --- a/test/distrotest +++ b/test/distrotest @@ -17,13 +17,13 @@ and is still highly experimental. Make sure you're plugged in and have screen/tmux in place, then re-run with $0 --run to continue. -Also note that dist* will be deleted. +Also note that dist*/ and .stack-work/ will be deleted. EOF exit 0 } -echo "Deleting 'dist' and 'dist-newstyle'..." -rm -rf dist dist-newstyle +echo "Deleting 'dist', 'dist-newstyle', and '.stack-work'..." +rm -rf dist dist-newstyle .stack-work execs=$(find . -name shellcheck) diff --git a/test/stacktest b/test/stacktest index 9eb8d1e..b486c31 100755 --- a/test/stacktest +++ b/test/stacktest @@ -15,7 +15,7 @@ die() { echo "$*" >&2; exit 1; } command -v stack || die "stack is missing" -stack setup || die "Failed to setup with default resolver" +stack setup --allow-different-user || die "Failed to setup with default resolver" stack build --test || die "Failed to build/test with default resolver" # Nice to haves, but not necessary From 195b70db8c697e44b65beeb83abe4c283cd4cda4 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Fri, 13 Dec 2024 23:06:49 -0500 Subject: [PATCH 222/244] Use unless instead of when and not --- src/ShellCheck/Checks/ShellSupport.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 2ec4cf7..f228832 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -330,7 +330,7 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do | t `isCommand` "echo" && argString `matches` flagRegex = if isBusyboxSh then - when (not (argString `matches` busyboxFlagRegex)) $ + unless (argString `matches` busyboxFlagRegex) $ warnMsg (getId arg) 3036 "echo flags besides -n and -e" else if isDash then From 0ecaf2b5f165497e461a47330ebbe11b05d8eb1a Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Fri, 13 Dec 2024 23:19:36 -0500 Subject: [PATCH 223/244] Use foldr instead of explicit recursion --- src/ShellCheck/Analytics.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 7f7a572..3a47ed9 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -5074,10 +5074,9 @@ checkExpansionWithRedirection params t = (T_Pipeline _ _ t@(_:_)) -> checkCmd id (last t) _ -> return () - checkCmd captureId (T_Redirecting _ redirs _) = walk captureId redirs + checkCmd captureId (T_Redirecting _ redirs _) = foldr (walk captureId) (return ()) redirs - walk captureId [] = return () - walk captureId (t:rest) = + walk captureId t acc = case t of T_FdRedirect _ _ (T_IoDuplicate _ _ "1") -> return () T_FdRedirect id "1" (T_IoDuplicate _ _ _) -> return () @@ -5086,7 +5085,7 @@ checkExpansionWithRedirection params t = if getLiteralString file == Just "/dev/null" then emit id captureId False else emit id captureId True - _ -> walk captureId rest + _ -> acc emit redirectId captureId suggestTee = do warn captureId 2327 "This command substitution will be empty because the command's output gets redirected away." From 5adfea21eec84a6bc8bbcaf4e22c02461dd850d9 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Fri, 13 Dec 2024 23:20:48 -0500 Subject: [PATCH 224/244] Use the result of the comparison directly instead of an if/else --- src/ShellCheck/Analytics.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 3a47ed9..4757e57 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -5082,9 +5082,7 @@ checkExpansionWithRedirection params t = T_FdRedirect id "1" (T_IoDuplicate _ _ _) -> return () T_FdRedirect id "" (T_IoDuplicate _ op _) | op `elem` [T_GREATAND (Id 0), T_Greater (Id 0)] -> emit id captureId True T_FdRedirect id str (T_IoFile _ op file) | str `elem` ["", "1"] && op `elem` [ T_DGREAT (Id 0), T_Greater (Id 0) ] -> - if getLiteralString file == Just "/dev/null" - then emit id captureId False - else emit id captureId True + emit id captureId $ getLiteralString file /= Just "/dev/null" _ -> acc emit redirectId captureId suggestTee = do From 26b949b9b0b1552639fdf24411096cf00749be18 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Fri, 13 Dec 2024 23:45:32 -0500 Subject: [PATCH 225/244] Use mapM_ instead of isJust and fromJust --- src/ShellCheck/Checks/Commands.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index c10016e..c37a67d 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -1431,9 +1431,8 @@ prop_checkBackreferencingDeclaration7 = verify (checkBackreferencingDeclaration checkBackreferencingDeclaration cmd = CommandCheck (Exactly cmd) check where check t = do - cfga <- asks cfgAnalysis - when (isJust cfga) $ - foldM_ (perArg $ fromJust cfga) M.empty $ arguments t + maybeCfga <- asks cfgAnalysis + mapM_ (\cfga -> foldM_ (perArg cfga) M.empty $ arguments t) maybeCfga perArg cfga leftArgs t = case t of From 7deb7e853b4bc5d2ad90f021de180055e87611b5 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Fri, 13 Dec 2024 23:47:55 -0500 Subject: [PATCH 226/244] Use mapM_ instead of sequence_ and <$> --- src/ShellCheck/Checks/ControlFlow.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Checks/ControlFlow.hs b/src/ShellCheck/Checks/ControlFlow.hs index d23fa15..9f63141 100644 --- a/src/ShellCheck/Checks/ControlFlow.hs +++ b/src/ShellCheck/Checks/ControlFlow.hs @@ -78,7 +78,7 @@ controlFlowEffectChecks = [ runNodeChecks :: [ControlFlowNodeCheck] -> ControlFlowCheck runNodeChecks perNode = do cfg <- asks cfgAnalysis - sequence_ $ runOnAll <$> cfg + mapM_ runOnAll cfg where getData datas n@(node, label) = do (pre, post) <- M.lookup node datas From d3001f337aa3f7653a621b302261f4eac01890d0 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Fri, 13 Dec 2024 23:57:50 -0500 Subject: [PATCH 227/244] Simplify getParseOutput --- src/ShellCheck/Parser.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 66d62ff..9628b2e 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -3451,12 +3451,12 @@ isNotOk p s = parsesCleanly p s == Nothing -- The string does not parse -- If the parser matches the string, return Right [ParseNotes+ParseProblems] -- If it does not match the string, return Left [ParseProblems] getParseOutput parser string = runIdentity $ do - (res, sys) <- runParser testEnvironment - (parser >> eof >> getState) "-" string - case (res, sys) of - (Right userState, systemState) -> - return $ Right $ parseNotes userState ++ parseProblems systemState - (Left _, systemState) -> return $ Left $ parseProblems systemState + (res, systemState) <- runParser testEnvironment + (parser >> eof >> getState) "-" string + return $ case res of + Right userState -> + Right $ parseNotes userState ++ parseProblems systemState + Left _ -> Left $ parseProblems systemState -- If the parser matches the string, return Just whether it was clean (without emitting suggestions) -- Otherwise, Nothing From fe315a25c42219b8a7b0b16ffa69351421e2e997 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lawrence=20Vel=C3=A1zquez?= Date: Sat, 28 Dec 2024 03:05:07 -0500 Subject: [PATCH 228/244] Recognize internal variables new in bash 5.3 From the bug-bash@gnu.org announcement "Bash-5.3-beta available": q. GLOBSORT: new variable to specify how to sort the results of pathname expansion (name, size, blocks, mtime, atime, ctime, none) in ascending or descending order. w. BASH_MONOSECONDS: new dynamic variable that returns the value of the system's monotonic clock, if one is available. x. BASH_TRAPSIG: new variable, set to the numeric signal number of the trap being executed while it's running. https://lists.gnu.org/archive/html/bug-bash/2024-12/msg00120.html --- src/ShellCheck/Data.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 3000a99..3876507 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -49,6 +49,7 @@ internalVariables = [ "LINES", "MAIL", "MAILCHECK", "MAILPATH", "OPTERR", "PATH", "POSIXLY_CORRECT", "PROMPT_COMMAND", "PROMPT_DIRTRIM", "PS0", "PS1", "PS2", "PS3", "PS4", "SHELL", "TIMEFORMAT", "TMOUT", "TMPDIR", + "BASH_MONOSECONDS", "BASH_TRAPSIG", "GLOBSORT", "auto_resume", "histchars", -- Other @@ -78,7 +79,7 @@ variablesWithoutSpaces = specialVariablesWithoutSpaces ++ [ "EPOCHREALTIME", "EPOCHSECONDS", "LINENO", "OPTIND", "PPID", "RANDOM", "READLINE_ARGUMENT", "READLINE_MARK", "READLINE_POINT", "SECONDS", "SHELLOPTS", "SHLVL", "SRANDOM", "UID", "COLUMNS", "HISTFILESIZE", - "HISTSIZE", "LINES" + "HISTSIZE", "LINES", "BASH_MONOSECONDS", "BASH_TRAPSIG" -- shflags , "FLAGS_ERROR", "FLAGS_FALSE", "FLAGS_TRUE" From cbf0b33463601fbd9827db31e08db424e3381074 Mon Sep 17 00:00:00 2001 From: Adrian Fluturel Date: Tue, 7 Jan 2025 03:24:29 +0100 Subject: [PATCH 229/244] Skip SC2015 when the last command is true --- src/ShellCheck/Analytics.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 4757e57..1329c86 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -881,13 +881,15 @@ prop_checkShorthandIf6 = verifyNot checkShorthandIf "if foo && bar || baz; then prop_checkShorthandIf7 = verifyNot checkShorthandIf "while foo && bar || baz; do true; done" prop_checkShorthandIf8 = verify checkShorthandIf "if true; then foo && bar || baz; fi" prop_checkShorthandIf9 = verifyNot checkShorthandIf "foo && [ -x /file ] || bar" +prop_checkShorthandIf10 = verifyNot checkShorthandIf "foo && bar || true" +prop_checkShorthandIf11 = verify checkShorthandIf "foo && bar || false" checkShorthandIf params x@(T_OrIf _ (T_AndIf id _ b) (T_Pipeline _ _ t)) | not (isOk t || inCondition) && not (isTestCommand b) = info id 2015 "Note that A && B || C is not if-then-else. C may run when A is true." where isOk [t] = isAssignment t || fromMaybe False (do name <- getCommandBasename t - return $ name `elem` ["echo", "exit", "return", "printf"]) + return $ name `elem` ["echo", "exit", "return", "printf", "true"]) isOk _ = False inCondition = isCondition $ getPath (parentMap params) x checkShorthandIf _ _ = return () From 3a9ddae06b7e2293ebf61eaf8c71b01bbb769614 Mon Sep 17 00:00:00 2001 From: Eisuke Kawashima Date: Mon, 24 Mar 2025 05:49:06 +0900 Subject: [PATCH 230/244] fix(SC3013)!: remove SC3013 since the operators are specified by POSIX.1-2024 https://pubs.opengroup.org/onlinepubs/9799919799/utilities/test.html fix #3167 --- CHANGELOG.md | 2 ++ src/ShellCheck/Checks/ShellSupport.hs | 8 +------- 2 files changed, 3 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 612068d..1a24b53 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,8 @@ - SC2317 about unreachable commands is now less spammy for nested ones. - SC2292, optional suggestion for [[ ]], now triggers for Busybox. +### Removed +- SC3013: removed since the operators `-op/-nt/-ef` are specified in POSIX.1-2024 ## v0.10.0 - 2024-03-07 ### Added diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index f228832..1789b6f 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -86,7 +86,7 @@ checkForDecimals = ForShell [Sh, Dash, BusyboxSh, Bash] f prop_checkBashisms = verify checkBashisms "while read a; do :; done < <(a)" -prop_checkBashisms2 = verify checkBashisms "[ foo -nt bar ]" +prop_checkBashisms2 = verifyNot checkBashisms "[ foo -nt bar ]" prop_checkBashisms3 = verify checkBashisms "echo $((i++))" prop_checkBashisms4 = verify checkBashisms "rm !(*.hs)" prop_checkBashisms5 = verify checkBashisms "source file" @@ -252,12 +252,6 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just op, rhs]) | op `elem` [ "<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="] = unless isDash $ warnMsg id 3012 $ "lexicographical " ++ op ++ " is" - bashism (TC_Binary id SingleBracket op _ _) - | op `elem` [ "-ot", "-nt", "-ef" ] = - unless isDash $ warnMsg id 3013 $ op ++ " is" - bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just op, rhs]) - | op `elem` [ "-ot", "-nt", "-ef" ] = - unless isDash $ warnMsg id 3013 $ op ++ " is" bashism (TC_Binary id SingleBracket "==" _ _) = unless isBusyboxSh $ warnMsg id 3014 "== in place of = is" bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just "==", rhs]) = From bc60607f9e5be0ea7528589410845aef2d6f10a3 Mon Sep 17 00:00:00 2001 From: Eisuke Kawashima Date: Mon, 24 Mar 2025 06:04:19 +0900 Subject: [PATCH 231/244] fix(SC3012)!: do not warn about `\<` and `\>` in test/[] as specified in POSIX.1-2024 https://pubs.opengroup.org/onlinepubs/9799919799/utilities/test.html fix #3168 --- CHANGELOG.md | 1 + src/ShellCheck/Checks/ShellSupport.hs | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 612068d..82630bf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,7 @@ - SC2002 about Useless Use Of Cat is now disabled by default. It can be re-enabled with `--enable=useless-use-of-cat` or equivalent directive. - SC2015 about `A && B || C` no longer triggers when B is a test command. +- SC3012: Do not warn about `\<` and `\>` in test/[] as specified in POSIX.1-2024 ### Fixed - SC2218 about function use-before-define is now more accurate. - SC2317 about unreachable commands is now less spammy for nested ones. diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index f228832..2a34931 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -247,10 +247,10 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do unless isBusyboxSh $ warnMsg id 3010 "[[ ]] is" bashism (T_HereString id _) = warnMsg id 3011 "here-strings are" bashism (TC_Binary id SingleBracket op _ _) - | op `elem` [ "<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="] = + | op `elem` [ "<", ">", "<=", ">=", "\\<=", "\\>="] = unless isDash $ warnMsg id 3012 $ "lexicographical " ++ op ++ " is" bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just op, rhs]) - | op `elem` [ "<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="] = + | op `elem` [ "<", ">", "<=", ">=", "\\<=", "\\>="] = unless isDash $ warnMsg id 3012 $ "lexicographical " ++ op ++ " is" bashism (TC_Binary id SingleBracket op _ _) | op `elem` [ "-ot", "-nt", "-ef" ] = From 4f628cbe2a617e76fe3686a79c3d1eaf443acc08 Mon Sep 17 00:00:00 2001 From: Eisuke Kawashima Date: Fri, 4 Apr 2025 17:31:07 +0900 Subject: [PATCH 232/244] feat: check tautologically-false conditionals MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - fix #3179 — negation of SC2055, `[ x = y -a x = z]` - fix #3181 — negation of SC2056, `(( x == y && x == z ))` - fix #3180 — negation of SC2252, `[ x = y ] && [ x = z ]` --- src/ShellCheck/Analytics.hs | 50 +++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 4757e57..431e56b 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -123,6 +123,7 @@ nodeChecks = [ ,checkCaseAgainstGlob ,checkCommarrays ,checkOrNeq + ,checkAndEq ,checkEchoWc ,checkConstantIfs ,checkPipedAssignment @@ -1631,6 +1632,55 @@ checkOrNeq _ (T_OrIf id lhs rhs) = sequence_ $ do checkOrNeq _ _ = return () +prop_checkAndEq1 = verify checkAndEq "if [[ $lol -eq cow && $lol -eq foo ]]; then echo foo; fi" +prop_checkAndEq2 = verify checkAndEq "(( a==lol && a==foo ))" +prop_checkAndEq3 = verify checkAndEq "[ \"$a\" = lol && \"$a\" = foo ]" +prop_checkAndEq4 = verifyNot checkAndEq "[ a = $cow && b = $foo ]" +prop_checkAndEq5 = verifyNot checkAndEq "[[ $a = /home && $a = */public_html/* ]]" +prop_checkAndEq6 = verify checkAndEq "[ $a = a ] && [ $a = b ]" +prop_checkAndEq7 = verify checkAndEq "[ $a = a ] && [ $a = b ] || true" +prop_checkAndEq8 = verifyNot checkAndEq "[[ $a == x && $a == x ]]" +prop_checkAndEq9 = verifyNot checkAndEq "[ 0 -eq $FOO ] && [ 0 -eq $BAR ]" + +-- For test-level "and": [ x = y -a x = z ] +checkAndEq _ (TC_And id typ op (TC_Binary _ _ op1 lhs1 rhs1 ) (TC_Binary _ _ op2 lhs2 rhs2)) + | (op1 == op2 && (op1 == "-eq" || op1 == "=" || op1 == "==")) && lhs1 == lhs2 && rhs1 /= rhs2 && not (any isGlob [rhs1,rhs2]) = + warn id 2055 $ "You probably wanted " ++ (if typ == SingleBracket then "-o" else "||") ++ " here, otherwise it's always false." + +-- For arithmetic context "and" +checkAndEq _ (TA_Binary id "&&" (TA_Binary _ "==" word1 _) (TA_Binary _ "==" word2 _)) + | word1 == word2 = + warn id 2056 "You probably wanted || here, otherwise it's always false." + +-- For command level "and": [ x = y ] && [ x = z ] +checkAndEq _ (T_AndIf id lhs rhs) = sequence_ $ do + (lhs1, op1, rhs1) <- getExpr lhs + (lhs2, op2, rhs2) <- getExpr rhs + guard $ op1 == op2 && op1 `elem` ["-eq", "=", "=="] + guard $ lhs1 == lhs2 && rhs1 /= rhs2 + guard . not $ any isGlob [rhs1, rhs2] + return $ warn id 2252 "You probably wanted || here, otherwise it's always false." + where + getExpr x = + case x of + T_AndIf _ lhs _ -> getExpr lhs -- Fetches x and y in `T_AndIf x (T_AndIf y z)` + T_Pipeline _ _ [x] -> getExpr x + T_Redirecting _ _ c -> getExpr c + T_Condition _ _ c -> getExpr c + TC_Binary _ _ op lhs rhs -> orient (lhs, op, rhs) + _ -> Nothing + + -- Swap items so that the constant side is rhs (or Nothing if both/neither is constant) + orient (lhs, op, rhs) = + case (isConstant lhs, isConstant rhs) of + (True, False) -> return (rhs, op, lhs) + (False, True) -> return (lhs, op, rhs) + _ -> Nothing + + +checkAndEq _ _ = return () + + prop_checkValidCondOps1 = verify checkValidCondOps "[[ a -xz b ]]" prop_checkValidCondOps2 = verify checkValidCondOps "[ -M a ]" prop_checkValidCondOps2a = verifyNot checkValidCondOps "[ 3 \\> 2 ]" From 8ff0c5be7a85561d23aea762f0495c144896aee3 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 6 Apr 2025 19:26:54 -0700 Subject: [PATCH 233/244] Suppress SC2216 when piping to cp/mv/rm -i (fixes #3141). --- src/ShellCheck/Analytics.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 4757e57..86a3292 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -3596,6 +3596,8 @@ prop_checkPipeToNowhere17 = verify checkPipeToNowhere "echo World | cat << 'EOF' prop_checkPipeToNowhere18 = verifyNot checkPipeToNowhere "ls 1>&3 3>&1 3>&- | wc -l" prop_checkPipeToNowhere19 = verifyNot checkPipeToNowhere "find . -print0 | du --files0-from=/dev/stdin" prop_checkPipeToNowhere20 = verifyNot checkPipeToNowhere "find . | du --exclude-from=/dev/fd/0" +prop_checkPipeToNowhere21 = verifyNot checkPipeToNowhere "yes | cp -ri foo/* bar" +prop_checkPipeToNowhere22 = verifyNot checkPipeToNowhere "yes | rm --interactive *" data PipeType = StdoutPipe | StdoutStderrPipe | NoPipe deriving (Eq) checkPipeToNowhere :: Parameters -> Token -> WriterT [TokenComment] Identity () @@ -3661,6 +3663,7 @@ checkPipeToNowhere params t = commandSpecificException name cmd = case name of "du" -> any ((`elem` ["exclude-from", "files0-from"]) . snd) $ getAllFlags cmd + _ | name `elem` interactiveFlagCmds -> hasInteractiveFlag cmd _ -> False warnAboutDupes (n, list@(_:_:_)) = @@ -3684,7 +3687,7 @@ checkPipeToNowhere params t = name <- getCommandBasename cmd guard $ name `elem` nonReadingCommands guard . not $ hasAdditionalConsumers cmd - guard . not $ name `elem` ["cp", "mv", "rm"] && cmd `hasFlag` "i" + guard . not $ name `elem` interactiveFlagCmds && hasInteractiveFlag cmd let suggestion = if name == "echo" then "Did you want 'cat' instead?" @@ -3699,6 +3702,9 @@ checkPipeToNowhere params t = treeContains pred t = isNothing $ doAnalysis (guard . not . pred) t + interactiveFlagCmds = [ "cp", "mv", "rm" ] + hasInteractiveFlag cmd = cmd `hasFlag` "i" || cmd `hasFlag` "interactive" + mayConsume t = case t of T_ProcSub _ "<" _ -> True From 72af76f443b81bbcd10889df8caf19be1671f7a2 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 6 Apr 2025 19:58:13 -0700 Subject: [PATCH 234/244] Supress SC2093 when execfail is set (fixes #3178) --- src/ShellCheck/Analytics.hs | 4 +++- src/ShellCheck/AnalyzerLib.hs | 6 ++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 86a3292..e6a1fd6 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1896,7 +1896,9 @@ prop_checkSpuriousExec8 = verifyNot checkSpuriousExec "exec {origout}>&1- >tmp.l prop_checkSpuriousExec9 = verify checkSpuriousExec "for file in rc.d/*; do exec \"$file\"; done" prop_checkSpuriousExec10 = verifyNot checkSpuriousExec "exec file; r=$?; printf >&2 'failed\n'; return $r" prop_checkSpuriousExec11 = verifyNot checkSpuriousExec "exec file; :" -checkSpuriousExec _ = doLists +prop_checkSpuriousExec12 = verifyNot checkSpuriousExec "#!/bin/bash\nshopt -s execfail; exec foo; exec bar; echo 'Error'; exit 1;" +prop_checkSpuriousExec13 = verify checkSpuriousExec "#!/bin/dash\nshopt -s execfail; exec foo; exec bar; echo 'Error'; exit 1;" +checkSpuriousExec params t = when (not $ hasExecfail params) $ doLists t where doLists (T_Script _ _ cmds) = doList cmds False doLists (T_BraceGroup _ cmds) = doList cmds False diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 531ce8b..da528a4 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -89,6 +89,8 @@ data Parameters = Parameters { hasSetE :: Bool, -- Whether this script has 'set -o pipefail' anywhere. hasPipefail :: Bool, + -- Whether this script has 'shopt -s execfail' anywhere. + hasExecfail :: Bool, -- A linear (bad) analysis of data flow variableFlow :: [StackData], -- A map from Id to Token @@ -226,6 +228,10 @@ makeParameters spec = params BusyboxSh -> isOptionSet "pipefail" root Sh -> True Ksh -> isOptionSet "pipefail" root, + hasExecfail = + case shellType params of + Bash -> isOptionSet "execfail" root + _ -> False, shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec), idMap = getTokenMap root, parentMap = getParentTree root, From e4853af5b0f541d8070d9c76adb59ccd9b1b44f0 Mon Sep 17 00:00:00 2001 From: Eisuke Kawashima Date: Fri, 21 Mar 2025 18:49:06 +0900 Subject: [PATCH 235/244] doc: update man --- shellcheck.1.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/shellcheck.1.md b/shellcheck.1.md index b873e45..c768bfe 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -78,7 +78,7 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts. : Don't try to look for .shellcheckrc configuration files. ---rcfile\ RCFILE +**--rcfile** *RCFILE* : Prefer the specified configuration file over searching for one in the default locations. @@ -317,7 +317,7 @@ Here is an example `.shellcheckrc`: disable=SC2236 If no `.shellcheckrc` is found in any of the parent directories, ShellCheck -will look in `~/.shellcheckrc` followed by the XDG config directory +will look in `~/.shellcheckrc` followed by the `$XDG_CONFIG_HOME` (usually `~/.config/shellcheckrc`) on Unix, or `%APPDATA%/shellcheckrc` on Windows. Only the first file found will be used. @@ -403,4 +403,4 @@ see https://gnu.org/licenses/gpl.html # SEE ALSO -sh(1) bash(1) +sh(1) bash(1) dash(1) ksh(1) From 574c6d18fbbae18b65b244ce2b37c3dced452a5a Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 8 Apr 2025 10:23:10 -0700 Subject: [PATCH 236/244] Suggest using test -e instead of -a (fixes #3174). --- CHANGELOG.md | 1 + src/ShellCheck/Analytics.hs | 10 ++++++++++ 2 files changed, 11 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 612068d..6309192 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,7 @@ - SC2327/SC2328: Warn about capturing the output of redirected commands. - SC2329: Warn when (non-escaping) functions are never invoked. - SC2330: Warn about unsupported glob matches with [[ .. ]] in BusyBox. +- SC2331: Suggest using standard -e instead of unary -a in tests. - Precompiled binaries for Linux riscv64 (linux.riscv64) ### Changed - SC2002 about Useless Use Of Cat is now disabled by default. It can be diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e6a1fd6..4984d44 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -204,6 +204,7 @@ nodeChecks = [ ,checkUnnecessaryParens ,checkPlusEqualsNumber ,checkExpansionWithRedirection + ,checkUnaryTestA ] optionalChecks = map fst optionalTreeChecks @@ -5098,6 +5099,15 @@ checkExpansionWithRedirection params t = err redirectId 2328 $ "This redirection takes output away from the command substitution" ++ if suggestTee then " (use tee to duplicate)." else "." +prop_checkUnaryTestA1 = verify checkUnaryTestA "[ -a foo ]" +prop_checkUnaryTestA2 = verify checkUnaryTestA "[ ! -a foo ]" +prop_checkUnaryTestA3 = verifyNot checkUnaryTestA "[ foo -a bar ]" +checkUnaryTestA params t = + case t of + TC_Unary id _ "-a" _ -> + styleWithFix id 2331 "For file existence, prefer standard -e over legacy -a." $ + fixWith [replaceStart id params 2 "-e"] + _ -> return () return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) From c41f3a4b8ac4eb7bcff230928a47f8f92f15f49d Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 8 Apr 2025 10:53:52 -0700 Subject: [PATCH 237/244] Warn about [ ! -o opt ] (and -a) being unconditionally true (fixes #3174) --- CHANGELOG.md | 2 ++ src/ShellCheck/Checks/ShellSupport.hs | 21 +++++++++++++++++++++ 2 files changed, 23 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6309192..bc646d7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,8 @@ - SC2329: Warn when (non-escaping) functions are never invoked. - SC2330: Warn about unsupported glob matches with [[ .. ]] in BusyBox. - SC2331: Suggest using standard -e instead of unary -a in tests. +- SC2332: Warn about `[ ! -o opt ]` being unconditionally true in Bash. +- SC3062: Warn about bashism `[ -o opt ]`. - Precompiled binaries for Linux riscv64 (linux.riscv64) ### Changed - SC2002 about Useless Use Of Cat is now disabled by default. It can be diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index f228832..624d474 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -63,6 +63,7 @@ checks = [ ,checkPS1Assignments ,checkMultipleBangs ,checkBangAfterPipe + ,checkNegatedUnaryOps ] testChecker (ForShell _ t) = @@ -218,6 +219,7 @@ prop_checkBashisms124 = verify checkBashisms "#!/bin/dash\ntype -p test" prop_checkBashisms125 = verifyNot checkBashisms "#!/bin/busybox sh\ntype -p test" prop_checkBashisms126 = verifyNot checkBashisms "#!/bin/busybox sh\nread -p foo -r bar" prop_checkBashisms127 = verifyNot checkBashisms "#!/bin/busybox sh\necho -ne foo" +prop_checkBashisms128 = verify checkBashisms "#!/bin/dash\ntype -p test" checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t @@ -272,6 +274,8 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do warnMsg id 3016 "unary -v (in place of [ -n \"${var+x}\" ]) is" bashism (TC_Unary id _ "-a" _) = warnMsg id 3017 "unary -a in place of -e is" + bashism (TC_Unary id _ "-o" _) = + warnMsg id 3062 "unary -o to check options is" bashism (T_SimpleCommand id _ [asStr -> Just "test", asStr -> Just "-a", _]) = warnMsg id 3017 "unary -a in place of -e is" bashism (TA_Unary id op _) @@ -649,5 +653,22 @@ checkBangAfterPipe = ForShell [Dash, BusyboxSh, Sh, Bash] f err id 2326 "! is not allowed in the middle of pipelines. Use command group as in cmd | { ! cmd; } if necessary." _ -> return () + +prop_checkNegatedUnaryOps1 = verify checkNegatedUnaryOps "[ ! -o braceexpand ]" +prop_checkNegatedUnaryOps2 = verifyNot checkNegatedUnaryOps "[ -o braceexpand ]" +prop_checkNegatedUnaryOps3 = verifyNot checkNegatedUnaryOps "[[ ! -o braceexpand ]]" +prop_checkNegatedUnaryOps4 = verifyNot checkNegatedUnaryOps "! [ -o braceexpand ]" +prop_checkNegatedUnaryOps5 = verify checkNegatedUnaryOps "[ ! -a file ]" +checkNegatedUnaryOps = ForShell [Bash] f + where + f token = case token of + TC_Unary id SingleBracket "!" (TC_Unary _ _ op _) | op `elem` ["-a", "-o"] -> + err id 2332 $ msg op + _ -> return () + + msg "-o" = "[ ! -o opt ] is always true because -o becomes logical OR. Use [[ ]] or ! [ -o opt ]." + msg "-a" = "[ ! -a file ] is always true because -a becomes logical AND. Use -e instead." + msg _ = pleaseReport "unhandled negated unary message" + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) From 7fc992d0dc590f32bd7265e719757102f5ad3b76 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 8 Apr 2025 20:52:52 -0700 Subject: [PATCH 238/244] Suppress SC2119/SC2120 for ${1:-default} (fixes #2023) --- src/ShellCheck/Analytics.hs | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 4984d44..85104d8 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2825,6 +2825,8 @@ prop_checkUnpassedInFunctions11 = verifyNotTree checkUnpassedInFunctions "foo() prop_checkUnpassedInFunctions12 = verifyNotTree checkUnpassedInFunctions "foo() { echo ${!var*}; }; foo;" prop_checkUnpassedInFunctions13 = verifyNotTree checkUnpassedInFunctions "# shellcheck disable=SC2120\nfoo() { echo $1; }\nfoo\n" prop_checkUnpassedInFunctions14 = verifyTree checkUnpassedInFunctions "foo() { echo $#; }; foo" +prop_checkUnpassedInFunctions15 = verifyNotTree checkUnpassedInFunctions "foo() { echo ${1-x}; }; foo" +prop_checkUnpassedInFunctions16 = verifyNotTree checkUnpassedInFunctions "foo() { echo ${1:-x}; }; foo" checkUnpassedInFunctions params root = execWriter $ mapM_ warnForGroup referenceGroups where @@ -2841,9 +2843,10 @@ checkUnpassedInFunctions params root = case x of Assignment (_, _, str, _) -> isPositional str _ -> False + isPositionalReference function x = case x of - Reference (_, t, str) -> isPositional str && t `isDirectChildOf` function + Reference (_, t, str) -> isPositional str && t `isDirectChildOf` function && not (hasDefaultValue t) _ -> False isDirectChildOf child parent = fromMaybe False $ do @@ -2857,6 +2860,7 @@ checkUnpassedInFunctions params root = referenceList :: [(String, Bool, Token)] referenceList = execWriter $ doAnalysis (sequence_ . checkCommand) root + checkCommand :: Token -> Maybe (Writer [(String, Bool, Token)] ()) checkCommand t@(T_SimpleCommand _ _ (cmd:args)) = do str <- getLiteralString cmd @@ -2867,6 +2871,21 @@ checkUnpassedInFunctions params root = isPositional str = str == "*" || str == "@" || str == "#" || (all isDigit str && str /= "0" && str /= "") + -- True if t is a variable that specifies a default value, + -- such as ${1-x} or ${1:-x}. + hasDefaultValue t = + case t of + T_DollarBraced _ True l -> + let str = concat $ oversimplify l + in isDefaultValueModifier $ getBracedModifier str + _ -> False + + isDefaultValueModifier str = + case str of + '-':_ -> True + ':':'-':_ -> True + _ -> False + isArgumentless (_, b, _) = b referenceGroups = Map.elems $ foldr updateWith Map.empty referenceList updateWith x@(name, _, _) = Map.insertWith (++) name [x] From 553a80f77ad6426107fe5fefcdc950e64c420b1d Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 8 Apr 2025 21:21:50 -0700 Subject: [PATCH 239/244] Also ignore SC2119 for :? and :+. --- src/ShellCheck/Analytics.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 85104d8..9eec8ed 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2827,6 +2827,8 @@ prop_checkUnpassedInFunctions13 = verifyNotTree checkUnpassedInFunctions "# shel prop_checkUnpassedInFunctions14 = verifyTree checkUnpassedInFunctions "foo() { echo $#; }; foo" prop_checkUnpassedInFunctions15 = verifyNotTree checkUnpassedInFunctions "foo() { echo ${1-x}; }; foo" prop_checkUnpassedInFunctions16 = verifyNotTree checkUnpassedInFunctions "foo() { echo ${1:-x}; }; foo" +prop_checkUnpassedInFunctions17 = verifyNotTree checkUnpassedInFunctions "foo() { mycommand ${1+--verbose}; }; foo" +prop_checkUnpassedInFunctions18 = verifyNotTree checkUnpassedInFunctions "foo() { if mycheck; then foo ${1?Missing}; fi; }; foo" checkUnpassedInFunctions params root = execWriter $ mapM_ warnForGroup referenceGroups where @@ -2882,9 +2884,10 @@ checkUnpassedInFunctions params root = isDefaultValueModifier str = case str of - '-':_ -> True - ':':'-':_ -> True + ':':c:_ -> c `elem` handlesDefault + c:_ -> c `elem` handlesDefault _ -> False + where handlesDefault = "-+?" isArgumentless (_, b, _) = b referenceGroups = Map.elems $ foldr updateWith Map.empty referenceList From efb5a5a2741e690d43d5539809326d5e249fd9f2 Mon Sep 17 00:00:00 2001 From: Eisuke Kawashima Date: Tue, 25 Mar 2025 01:31:06 +0900 Subject: [PATCH 240/244] fix(SC3013): check POSIX-compliant unary operators for test and [ fix #2125 --- src/ShellCheck/Checks/ShellSupport.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 624d474..2039483 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -220,6 +220,9 @@ prop_checkBashisms125 = verifyNot checkBashisms "#!/bin/busybox sh\ntype -p test prop_checkBashisms126 = verifyNot checkBashisms "#!/bin/busybox sh\nread -p foo -r bar" prop_checkBashisms127 = verifyNot checkBashisms "#!/bin/busybox sh\necho -ne foo" prop_checkBashisms128 = verify checkBashisms "#!/bin/dash\ntype -p test" +prop_checkBashisms129 = verify checkBashisms "#!/bin/sh\n[ -k /tmp ]" +prop_checkBashisms130 = verifyNot checkBashisms "#!/bin/dash\ntest -k /tmp" +prop_checkBashisms131 = verify checkBashisms "#!/bin/sh\n[ -o errexit ]" checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do params <- ask kludge params t @@ -254,6 +257,18 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just op, rhs]) | op `elem` [ "<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="] = unless isDash $ warnMsg id 3012 $ "lexicographical " ++ op ++ " is" + bashism (TC_Unary id _ op _) + | op `elem` [ "-k", "-G", "-O" ] = + unless isDash $ warnMsg id 3013 $ op ++ " is" + bashism (T_SimpleCommand id _ [asStr -> Just "test", asStr -> Just op, _]) + | op `elem` [ "-k", "-G", "-O" ] = + unless isDash $ warnMsg id 3013 $ op ++ " is" + bashism (TC_Unary id _ op _) + | op `elem` [ "-N", "-o", "-R" ] = + warnMsg id 3013 $ op ++ " is" + bashism (T_SimpleCommand id _ [asStr -> Just "test", asStr -> Just op, _]) + | op `elem` [ "-N", "-o", "-R" ] = + warnMsg id 3013 $ op ++ " is" bashism (TC_Binary id SingleBracket op _ _) | op `elem` [ "-ot", "-nt", "-ef" ] = unless isDash $ warnMsg id 3013 $ op ++ " is" From dc41f0cc5bdcf1c814b184892b20ee0d2822e95a Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 11 Apr 2025 14:14:09 -0700 Subject: [PATCH 241/244] Refactor checks for POSIX test flags --- src/ShellCheck/Checks/ShellSupport.hs | 98 +++++++++++++++------------ 1 file changed, 56 insertions(+), 42 deletions(-) diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 2039483..c828555 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -251,48 +251,16 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do bashism (T_Condition id DoubleBracket _) = unless isBusyboxSh $ warnMsg id 3010 "[[ ]] is" bashism (T_HereString id _) = warnMsg id 3011 "here-strings are" - bashism (TC_Binary id SingleBracket op _ _) - | op `elem` [ "<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="] = - unless isDash $ warnMsg id 3012 $ "lexicographical " ++ op ++ " is" - bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just op, rhs]) - | op `elem` [ "<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="] = - unless isDash $ warnMsg id 3012 $ "lexicographical " ++ op ++ " is" - bashism (TC_Unary id _ op _) - | op `elem` [ "-k", "-G", "-O" ] = - unless isDash $ warnMsg id 3013 $ op ++ " is" - bashism (T_SimpleCommand id _ [asStr -> Just "test", asStr -> Just op, _]) - | op `elem` [ "-k", "-G", "-O" ] = - unless isDash $ warnMsg id 3013 $ op ++ " is" - bashism (TC_Unary id _ op _) - | op `elem` [ "-N", "-o", "-R" ] = - warnMsg id 3013 $ op ++ " is" - bashism (T_SimpleCommand id _ [asStr -> Just "test", asStr -> Just op, _]) - | op `elem` [ "-N", "-o", "-R" ] = - warnMsg id 3013 $ op ++ " is" - bashism (TC_Binary id SingleBracket op _ _) - | op `elem` [ "-ot", "-nt", "-ef" ] = - unless isDash $ warnMsg id 3013 $ op ++ " is" - bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just op, rhs]) - | op `elem` [ "-ot", "-nt", "-ef" ] = - unless isDash $ warnMsg id 3013 $ op ++ " is" - bashism (TC_Binary id SingleBracket "==" _ _) = - unless isBusyboxSh $ warnMsg id 3014 "== in place of = is" - bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just "==", rhs]) = - unless isBusyboxSh $ warnMsg id 3014 "== in place of = is" - bashism (TC_Binary id SingleBracket "=~" _ _) = - warnMsg id 3015 "=~ regex matching is" - bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just "=~", rhs]) = - warnMsg id 3015 "=~ regex matching is" - bashism (TC_Unary id SingleBracket "-v" _) = - warnMsg id 3016 "unary -v (in place of [ -n \"${var+x}\" ]) is" - bashism (T_SimpleCommand id _ [asStr -> Just "test", asStr -> Just "-v", _]) = - warnMsg id 3016 "unary -v (in place of [ -n \"${var+x}\" ]) is" - bashism (TC_Unary id _ "-a" _) = - warnMsg id 3017 "unary -a in place of -e is" - bashism (TC_Unary id _ "-o" _) = - warnMsg id 3062 "unary -o to check options is" - bashism (T_SimpleCommand id _ [asStr -> Just "test", asStr -> Just "-a", _]) = - warnMsg id 3017 "unary -a in place of -e is" + + bashism (TC_Binary id _ op _ _) = + checkTestOp bashismBinaryTestFlags op id + bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just op, rhs]) = + checkTestOp bashismBinaryTestFlags op id + bashism (TC_Unary id _ op _) = + checkTestOp bashismUnaryTestFlags op id + bashism (T_SimpleCommand id _ [asStr -> Just "test", asStr -> Just op, _]) = + checkTestOp bashismUnaryTestFlags op id + bashism (TA_Unary id op _) | op `elem` [ "|++", "|--", "++|", "--|"] = warnMsg id 3018 $ filter (/= '|') op ++ " is" @@ -529,6 +497,52 @@ checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do Assignment (_, _, name, _) -> name == var _ -> False + checkTestOp table op id = sequence_ $ do + (code, shells, msg) <- Map.lookup op table + guard . not $ shellType params `elem` shells + return $ warnMsg id code (msg op) + + +buildTestFlagMap list = Map.fromList $ concatMap (\(x,y) -> map (\c -> (c,y)) x) list +bashismBinaryTestFlags = buildTestFlagMap [ + -- ([list of applicable flags], + -- (error code, exempt shells, message builder :: String -> String)), + -- + -- Distinct error codes allow the wiki to give more helpful, targeted + -- information. + (["<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="], + (3012, [Dash, BusyboxSh], \op -> "lexicographical " ++ op ++ " is")), + (["-nt", "-ot", "-ef"], + (3013, [Dash, BusyboxSh], \op -> op ++ " is")), + (["=="], + (3014, [BusyboxSh], \op -> op ++ " in place of = is")), + (["=~"], + (3015, [], \op -> op ++ " regex matching is")), + + ([], (0,[],const "")) + ] +bashismUnaryTestFlags = buildTestFlagMap [ + (["-v"], + (3016, [], \op -> "test " ++ op ++ " (in place of [ -n \"${var+x}\" ]) is")), + (["-a"], + (3017, [], \op -> "unary " ++ op ++ " in place of -e is")), + (["-o"], + (3062, [], \op -> "test " ++ op ++ " to check options is")), + (["-R"], + (3063, [], \op -> "test " ++ op ++ " and namerefs in general are")), + (["-N"], + (3064, [], \op -> "test " ++ op ++ " is")), + (["-k"], + (3065, [Dash, BusyboxSh], \op -> "test " ++ op ++ " is")), + (["-G"], + (3066, [Dash, BusyboxSh], \op -> "test " ++ op ++ " is")), + (["-O"], + (3067, [Dash, BusyboxSh], \op -> "test " ++ op ++ " is")), + + ([], (0,[],const "")) + ] + + prop_checkEchoSed1 = verify checkEchoSed "FOO=$(echo \"$cow\" | sed 's/foo/bar/g')" prop_checkEchoSed1b = verify checkEchoSed "FOO=$(sed 's/foo/bar/g' <<< \"$cow\")" prop_checkEchoSed2 = verify checkEchoSed "rm $(echo $cow | sed -e 's,foo,bar,')" From f78714e0f6070bc4efa2f7c11c1ad632e8c250a2 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Fri, 11 Apr 2025 19:14:53 -0700 Subject: [PATCH 242/244] Add ":" alongside "true" for SC2015 --- src/ShellCheck/Analytics.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 5f8c84c..ac686ff 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -890,7 +890,7 @@ checkShorthandIf params x@(T_OrIf _ (T_AndIf id _ b) (T_Pipeline _ _ t)) where isOk [t] = isAssignment t || fromMaybe False (do name <- getCommandBasename t - return $ name `elem` ["echo", "exit", "return", "printf", "true"]) + return $ name `elem` ["echo", "exit", "return", "printf", "true", ":"]) isOk _ = False inCondition = isCondition $ getPath (parentMap params) x checkShorthandIf _ _ = return () From b381658dbc74ebe7141717f7723be3a8b39121f9 Mon Sep 17 00:00:00 2001 From: Ian Ehrenwald Date: Fri, 25 Apr 2025 14:11:07 -0400 Subject: [PATCH 243/244] Add python3 to the list of badShells --- src/ShellCheck/Parser.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index d019d89..84c3ce4 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -3397,6 +3397,7 @@ readScriptFile sourced = do "fish", "perl", "python", + "python3", "ruby", "tcsh", "zsh" From 47d358c1d44a84a1d54a4118fba4cf7668a9225d Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 17 May 2025 00:55:50 +0000 Subject: [PATCH 244/244] Tighten SC2333/SC2334 to only trigger against literals. --- src/ShellCheck/ASTLib.hs | 6 ++++++ src/ShellCheck/Analytics.hs | 29 +++++++++++++++++++---------- 2 files changed, 25 insertions(+), 10 deletions(-) diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 6b26b22..1e1b9cd 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -446,6 +446,12 @@ getLiteralStringExt more = g -- Is this token a string literal? isLiteral t = isJust $ getLiteralString t +-- Is this token a string literal number? +isLiteralNumber t = fromMaybe False $ do + s <- getLiteralString t + guard $ all isDigit s + return True + -- Escape user data for messages. -- Messages generally avoid repeating user data, but sometimes it's helpful. e4m = escapeForMessage diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 073e911..2e9a3bd 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1635,8 +1635,8 @@ checkOrNeq _ (T_OrIf id lhs rhs) = sequence_ $ do checkOrNeq _ _ = return () -prop_checkAndEq1 = verify checkAndEq "if [[ $lol -eq cow && $lol -eq foo ]]; then echo foo; fi" -prop_checkAndEq2 = verify checkAndEq "(( a==lol && a==foo ))" +prop_checkAndEq1 = verifyNot checkAndEq "cow=0; foo=0; if [[ $lol -eq cow && $lol -eq foo ]]; then echo foo; fi" +prop_checkAndEq2 = verifyNot checkAndEq "lol=0 foo=0; (( a==lol && a==foo ))" prop_checkAndEq3 = verify checkAndEq "[ \"$a\" = lol && \"$a\" = foo ]" prop_checkAndEq4 = verifyNot checkAndEq "[ a = $cow && b = $foo ]" prop_checkAndEq5 = verifyNot checkAndEq "[[ $a = /home && $a = */public_html/* ]]" @@ -1644,25 +1644,34 @@ prop_checkAndEq6 = verify checkAndEq "[ $a = a ] && [ $a = b ]" prop_checkAndEq7 = verify checkAndEq "[ $a = a ] && [ $a = b ] || true" prop_checkAndEq8 = verifyNot checkAndEq "[[ $a == x && $a == x ]]" prop_checkAndEq9 = verifyNot checkAndEq "[ 0 -eq $FOO ] && [ 0 -eq $BAR ]" +prop_checkAndEq10 = verify checkAndEq "(( a == 1 && a == 2 ))" +prop_checkAndEq11 = verify checkAndEq "[ $x -eq 1 ] && [ $x -eq 2 ]" +prop_checkAndEq12 = verify checkAndEq "[ 1 -eq $x ] && [ $x -eq 2 ]" +prop_checkAndEq13 = verifyNot checkAndEq "[ 1 -eq $x ] && [ $x -eq 1 ]" +prop_checkAndEq14 = verifyNot checkAndEq "[ $a = $b ] && [ $a = $c ]" + +checkAndEqOperands "-eq" rhs1 rhs2 = isLiteralNumber rhs1 && isLiteralNumber rhs2 +checkAndEqOperands op rhs1 rhs2 | op == "=" || op == "==" = isLiteral rhs1 && isLiteral rhs2 +checkAndEqOperands _ _ _ = False -- For test-level "and": [ x = y -a x = z ] checkAndEq _ (TC_And id typ op (TC_Binary _ _ op1 lhs1 rhs1 ) (TC_Binary _ _ op2 lhs2 rhs2)) - | (op1 == op2 && (op1 == "-eq" || op1 == "=" || op1 == "==")) && lhs1 == lhs2 && rhs1 /= rhs2 && not (any isGlob [rhs1,rhs2]) = - warn id 2055 $ "You probably wanted " ++ (if typ == SingleBracket then "-o" else "||") ++ " here, otherwise it's always false." + | op1 == op2 && lhs1 == lhs2 && rhs1 /= rhs2 && checkAndEqOperands op1 rhs1 rhs2 = + warn id 2333 $ "You probably wanted " ++ (if typ == SingleBracket then "-o" else "||") ++ " here, otherwise it's always false." -- For arithmetic context "and" -checkAndEq _ (TA_Binary id "&&" (TA_Binary _ "==" word1 _) (TA_Binary _ "==" word2 _)) - | word1 == word2 = - warn id 2056 "You probably wanted || here, otherwise it's always false." +checkAndEq _ (TA_Binary id "&&" (TA_Binary _ "==" lhs1 rhs1) (TA_Binary _ "==" lhs2 rhs2)) + | lhs1 == lhs2 && isLiteralNumber rhs1 && isLiteralNumber rhs2 = + warn id 2334 "You probably wanted || here, otherwise it's always false." -- For command level "and": [ x = y ] && [ x = z ] checkAndEq _ (T_AndIf id lhs rhs) = sequence_ $ do (lhs1, op1, rhs1) <- getExpr lhs (lhs2, op2, rhs2) <- getExpr rhs - guard $ op1 == op2 && op1 `elem` ["-eq", "=", "=="] + guard $ op1 == op2 guard $ lhs1 == lhs2 && rhs1 /= rhs2 - guard . not $ any isGlob [rhs1, rhs2] - return $ warn id 2252 "You probably wanted || here, otherwise it's always false." + guard $ checkAndEqOperands op1 rhs1 rhs2 + return $ warn id 2333 "You probably wanted || here, otherwise it's always false." where getExpr x = case x of