diff --git a/ShellCheck.cabal b/ShellCheck.cabal index f09521f..f94952e 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -66,7 +66,11 @@ library directory >= 1.2.3 && < 1.4, -- When cabal supports it, move this to setup-depends: - process + process, + + -- support for scanning Gentoo eclasses + attoparsec, + text exposed-modules: ShellCheck.AST ShellCheck.ASTLib @@ -93,6 +97,7 @@ library ShellCheck.Formatter.Quiet ShellCheck.Interface ShellCheck.Parser + ShellCheck.PortageVariables ShellCheck.Prelude ShellCheck.Regex other-modules: diff --git a/shellcheck.1.md b/shellcheck.1.md index 9675e79..cd7b22a 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -87,8 +87,9 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts. : Specify Bourne shell dialect. Valid values are *sh*, *bash*, *dash* and *ksh*. 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. + shebang, or `.bash/.bats/.dash/.ksh/.ebuild/.eclass` extension, in that + order. *sh* refers to POSIX `sh` (not the system's), and will warn of + portability issues. **-S**\ *SEVERITY*,\ **--severity=***severity* diff --git a/shellcheck.hs b/shellcheck.hs index c306440..09176a5 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -21,6 +21,7 @@ import qualified ShellCheck.Analyzer import ShellCheck.Checker import ShellCheck.Data import ShellCheck.Interface +import ShellCheck.PortageVariables import ShellCheck.Regex import qualified ShellCheck.Formatter.CheckStyle @@ -240,10 +241,22 @@ runFormatter sys format options files = do either (reportFailure filename) check input where check contents = do + + -- If this is a Gentoo ebuild file, scan for eclasses on the system + gentooData <- case getPortageFileType filename of + NonPortageRelated -> pure Map.empty + _ -> catch (portageVariables <$> scanRepos) $ \e -> do + let warnMsg = "Error when scanning for Gentoo repos: " + let err = show (e :: IOException) + hPutStr stderr ("Warning: " ++ warnMsg ++ err) + pure Map.empty + let checkspec = (checkSpec options) { csFilename = filename, - csScript = contents + csScript = contents, + csGentooData = gentooData } + result <- checkScript sys checkspec onResult format result sys return $ diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 64fa762..6cf48cb 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -36,8 +36,6 @@ import Numeric (showHex) import Test.QuickCheck -arguments (T_SimpleCommand _ _ (cmd:args)) = args - -- Is this a type of loop? isLoop t = case t of T_WhileExpression {} -> True @@ -559,11 +557,29 @@ getCommandNameFromExpansion t = extract (T_Pipeline _ _ [cmd]) = getCommandName cmd extract _ = Nothing +-- If a command substitution is a single command, get its argument Tokens. +-- Return an empty list if there are no arguments or the token is not a command substitution. +-- $(date +%s) = ["+%s"] +getArgumentsFromExpansion :: Token -> [Token] +getArgumentsFromExpansion t = + case t of + T_DollarExpansion _ [c] -> extract c + T_Backticked _ [c] -> extract c + T_DollarBraceCommandExpansion _ [c] -> extract c + _ -> [] + where + extract (T_Pipeline _ _ [cmd]) = arguments cmd + extract _ = [] + -- Get the basename of a token representing a command getCommandBasename = fmap basename . getCommandName basename = reverse . takeWhile (/= '/') . reverse +-- Get the arguments to a command +arguments (T_SimpleCommand _ _ (cmd:args)) = args +arguments t = maybe [] arguments (getCommand t) + isAssignment t = case t of T_Redirecting _ _ w -> isAssignment w diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 255c63d..1523da7 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -68,6 +68,7 @@ treeChecks = [ ,checkArrayAssignmentIndices ,checkUseBeforeDefinition ,checkAliasUsedInSameParsingUnit + ,checkForStableKeywordsin9999CrosWorkonEbuilds ,checkArrayValueUsedAsIndex ] @@ -291,6 +292,12 @@ verifyTree f s = producesComments f s == Just True verifyNotTree :: (Parameters -> Token -> [TokenComment]) -> String -> Bool verifyNotTree f s = producesComments f s == Just False +-- Takes a regular checker function and a Parameters and returns a new +-- checker function that acts as though portage mode had been passed +-- in the parameters. +withPortageParams :: (Parameters -> a) -> Parameters -> a +withPortageParams f p = f $ p { portageFileType = Ebuild False } + checkCommand str f t@(T_SimpleCommand id _ (cmd:rest)) | t `isCommand` str = f cmd rest checkCommand _ _ _ = return () @@ -778,6 +785,33 @@ checkFindExec _ cmd@(T_SimpleCommand _ _ t@(h:r)) | cmd `isCommand` "find" = do fromWord _ = [] checkFindExec _ _ = return () +commandNeverProducesSpaces params t = + maybe False (`elem` noSpaceCommands) cmd + || (maybe False (`elem` spacesFromArgsCommands) cmd && noArgsHaveSpaces t) + where + cmd = getCommandNameFromExpansion t + noSpaceCommands = + if isPortageBuild params + then + [ + "usev" + , "use_with" + , "use_enable" + ] + else + [] + spacesFromArgsCommands = + if isPortageBuild params + then + [ + "usex" + , "meson_use" + , "meson_feature" + ] + else + [] + noArgsHaveSpaces t = all (' ' `notElem`) (words $ getArgumentsFromExpansion t) + words = map $ getLiteralStringDef " " prop_checkUnquotedExpansions1 = verify checkUnquotedExpansions "rm $(ls)" prop_checkUnquotedExpansions1a = verify checkUnquotedExpansions "rm `ls`" @@ -790,6 +824,11 @@ prop_checkUnquotedExpansions6 = verifyNot checkUnquotedExpansions "$(cmd)" prop_checkUnquotedExpansions7 = verifyNot checkUnquotedExpansions "cat << foo\n$(ls)\nfoo" prop_checkUnquotedExpansions8 = verifyNot checkUnquotedExpansions "set -- $(seq 1 4)" prop_checkUnquotedExpansions9 = verifyNot checkUnquotedExpansions "echo foo `# inline comment`" +prop_checkUnquotedExpansionsUsev = verify checkUnquotedExpansions "echo $(usev X)" +prop_checkUnquotedExpansionsPortageUsev = verifyNot (withPortageParams checkUnquotedExpansions) "echo $(usev X)" +prop_checkUnquotedExpansionsUsex = verify checkUnquotedExpansions "echo $(usex X)" +prop_checkUnquotedExpansionsPortageUsex1 = verifyNot (withPortageParams checkUnquotedExpansions) "echo $(usex X \"\" Y)" +prop_checkUnquotedExpansionsPortageUsex2 = verify (withPortageParams checkUnquotedExpansions) "echo $(usex X \"Y Z\" W)" prop_checkUnquotedExpansions10 = verify checkUnquotedExpansions "#!/bin/sh\nexport var=$(val)" prop_checkUnquotedExpansions11 = verifyNot checkUnquotedExpansions "ps -p $(pgrep foo)" checkUnquotedExpansions params = @@ -801,7 +840,7 @@ checkUnquotedExpansions params = check _ = return () tree = parentMap params examine t contents = - unless (null contents || shouldBeSplit t || isQuoteFree (shellType params) tree t || usedAsCommandName tree t) $ + unless (null contents || shouldBeSplit t || isQuoteFree (shellType params) tree t || usedAsCommandName tree t || commandNeverProducesSpaces params t) $ warn (getId t) 2046 "Quote this to prevent word splitting." shouldBeSplit t = @@ -963,6 +1002,10 @@ checkArrayAsString _ (T_Assignment id _ _ _ word) = "Brace expansions and globs are literal in assignments. Quote it or use an array." checkArrayAsString _ _ = return () +allArrayVariables params = + shellArrayVariables ++ + if isPortageBuild params then portageArrayVariables else [] + prop_checkArrayWithoutIndex1 = verifyTree checkArrayWithoutIndex "foo=(a b); echo $foo" prop_checkArrayWithoutIndex2 = verifyNotTree checkArrayWithoutIndex "foo='bar baz'; foo=($foo); echo ${foo[0]}" prop_checkArrayWithoutIndex3 = verifyTree checkArrayWithoutIndex "coproc foo while true; do echo cow; done; echo $foo" @@ -978,6 +1021,7 @@ checkArrayWithoutIndex params _ = doVariableFlowAnalysis readF writeF defaultMap (variableFlow params) where defaultMap = Map.fromList $ map (\x -> (x,())) arrayVariables + arrayVariables = allArrayVariables params readF _ (T_DollarBraced id _ token) _ = do map <- get return . maybeToList $ do @@ -1070,6 +1114,9 @@ prop_checkSingleQuotedVariables22 = verifyNot checkSingleQuotedVariables "jq '$_ 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_checkSingleQuotedVariablesCros1 = verifyNot checkSingleQuotedVariables "python_gen_any_dep 'dev-python/pyyaml[${PYTHON_USEDEP}]'" +prop_checkSingleQuotedVariablesCros2 = verifyNot checkSingleQuotedVariables "python_gen_cond_dep 'dev-python/unittest2[${PYTHON_USEDEP}]' python2_7 pypy" +prop_checkSingleQuotedVariablesCros3 = verifyNot checkSingleQuotedVariables "version_format_string '${PN}_source_$1_$2-$3_$4'" checkSingleQuotedVariables params t@(T_SingleQuoted id s) = @@ -1109,6 +1156,9 @@ checkSingleQuotedVariables params t@(T_SingleQuoted id s) = ,"git filter-branch" ,"mumps -run %XCMD" ,"mumps -run LOOP%XCMD" + ,"python_gen_any_dep" + ,"python_gen_cond_dep" + ,"version_format_string" ] || "awk" `isSuffixOf` commandName || "perl" `isPrefixOf` commandName @@ -2036,6 +2086,47 @@ doVariableFlowAnalysis readFunc writeFunc empty flow = evalState ( writeFunc base token name values doFlow _ = return [] +-- Ensure that portage vars without spaces only exist when parsing portage files +allVariablesWithoutSpaces params = + variablesWithoutSpaces ++ + if isPortageBuild params then portageVariablesWithoutSpaces else [] + +getInheritedEclasses :: Token -> [String] +getInheritedEclasses root = execWriter $ doAnalysis findInheritedEclasses root + where + findInheritedEclasses cmd + | cmd `isCommand` "inherit" = tell $ catMaybes $ getLiteralString <$> (arguments cmd) + findInheritedEclasses _ = return () + +checkForStableKeywordsin9999CrosWorkonEbuilds :: Parameters -> Token -> [TokenComment] +checkForStableKeywordsin9999CrosWorkonEbuilds params root = + if isPortage9999Ebuild params && "cros-workon" `elem` getInheritedEclasses root + then ensureNoStableKeywords root + else [] + +prop_checkEnsureNoStableKeywords1 = verifyNotTree (const ensureNoStableKeywords) "KEYWORDS=\"~*\"" +prop_checkEnsureNoStableKeywords2 = verifyNotTree (const ensureNoStableKeywords) "KEYWORDS=\"-* ~amd64\"" +prop_checkEnsureNoStableKeywords3 = verifyTree (const ensureNoStableKeywords) "KEYWORDS=\"*\"" +prop_checkEnsureNoStableKeywords4 = verifyTree (const ensureNoStableKeywords) "KEYWORDS=\"-* amd64\"" +ensureNoStableKeywords :: Token -> [TokenComment] +ensureNoStableKeywords root = + execWriter $ doAnalysis warnStableKeywords root + +-- warnStableKeywords will emit an error if any KEYWORDS listed in the .ebuild +-- file are marked as stable. In practice, this means that there are any +-- KEYWORDS that do not begin with - or ~. +warnStableKeywords :: Token -> Writer [TokenComment] () +warnStableKeywords (T_Assignment _ Assign "KEYWORDS" [] + (T_NormalWord _ [T_DoubleQuoted id [(T_Literal _ keywords)]])) + | any isStableKeyword (words keywords) = + tell [makeComment ErrorC id 5000 $ + "All KEYWORDS in -9999.ebuild files inheriting from cros-workon must " ++ + "be marked as unstable (~*, ~amd64, etc...), or broken (-*, -amd64, etc...)."] +warnStableKeywords _ = return () + +isStableKeyword :: String -> Bool +isStableKeyword k = not (("~" `isPrefixOf` k) || ("-" `isPrefixOf` k)) + -- 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 = @@ -2317,6 +2408,16 @@ checkFunctionsUsedExternally params t = info definitionId 2032 $ "This function can't be invoked via " ++ cmd ++ patternContext cmdId +allInternalVariables params = + genericInternalVariables ++ + if shellType params == Ksh then kshInternalVariables else [] ++ + if isPortageBuild params + then + let eclasses = getInheritedEclasses $ rootNode params + gMap = gentooData params + in portageInternalVariables eclasses gMap + else [] + prop_checkUnused0 = verifyNotTree checkUnusedAssignments "var=foo; echo $var" prop_checkUnused1 = verifyTree checkUnusedAssignments "var=foo; echo $bar" prop_checkUnused2 = verifyNotTree checkUnusedAssignments "var=foo; export var;" @@ -2366,6 +2467,26 @@ prop_checkUnused44 = verifyNotTree checkUnusedAssignments "DEFINE_string \"foo$i 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_checkUnused_portageVarAssign = + verifyNotTree (withPortageParams checkUnusedAssignments) + "BROOT=2" +prop_checkUnused_portageVarAssignNoPortageParams = + verifyTree checkUnusedAssignments + "BROOT=2" +prop_checkUnused_portageInheritedVarAssign = + verifyNotTree (withPortageParams checkUnusedAssignments) + "inherit cargo; CARGO_INSTALL_PATH=2" +prop_checkUnused_portageInheritedVarAssignNoPortage = + verifyTree checkUnusedAssignments + "inherit cargo; CARGO_INSTALL_PATH=2" +prop_checkUnused_portageInheritedVarAssignNoInherit = + verifyTree (withPortageParams checkUnusedAssignments) + "CARGO_INSTALL_PATH=2" +prop_checkUnused_portageInheritedVarAssignNoInheritOrPortage = + verifyTree checkUnusedAssignments + "CARGO_INSTALL_PATH=2" +prop_checkUnusedTcExport = verifyNotTree checkUnusedAssignments "tc-export CC; echo $CC" +prop_checkUnusedTcExportBuildEnv = verifyNotTree checkUnusedAssignments "tc-export_build_env CC; echo $CC $BUILD_CFLAGS $CFLAGS_FOR_BUILD" 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" @@ -2393,6 +2514,7 @@ checkUnusedAssignments params t = execWriter (mapM_ warnFor unused) stripSuffix = takeWhile isVariableChar defaultMap = Map.fromList $ zip internalVariables $ repeat () + internalVariables = allInternalVariables params prop_checkUnassignedReferences1 = verifyTree checkUnassignedReferences "echo $foo" prop_checkUnassignedReferences2 = verifyNotTree checkUnassignedReferences "foo=hello; echo $foo" @@ -2443,6 +2565,24 @@ prop_checkUnassignedReferences_minusNBraced = verifyNotTree checkUnassignedRefe prop_checkUnassignedReferences_minusZBraced = verifyNotTree checkUnassignedReferences "if [ -z \"${x}\" ]; then echo \"\"; fi" prop_checkUnassignedReferences_minusNDefault = verifyNotTree checkUnassignedReferences "if [ -n \"${x:-}\" ]; then echo $x; fi" prop_checkUnassignedReferences_minusZDefault = verifyNotTree checkUnassignedReferences "if [ -z \"${x:-}\" ]; then echo \"\"; fi" +prop_checkUnassignedReference_portageVarReference = + verifyNotTree (withPortageParams (checkUnassignedReferences' True)) + "echo $BROOT" +prop_checkUnassignedReference_portageVarReferenceNoPortage = + verifyTree (checkUnassignedReferences' True) + "echo $BROOT" +prop_checkUnassignedReference_portageInheritedVarReference = + verifyNotTree (withPortageParams (checkUnassignedReferences' True)) + "inherit cargo; echo $CARGO_INSTALL_PATH" +prop_checkUnassignedReference_portageInheritedVarReferenceNoPortage = + verifyTree (checkUnassignedReferences' True) + "inherit cargo; echo $CARGO_INSTALL_PATH" +prop_checkUnassignedReference_portageInheritedVarReferenceNoInherit = + verifyTree (withPortageParams (checkUnassignedReferences' True)) + "echo $CARGO_INSTALL_PATH" +prop_checkUnassignedReference_portageInheritedVarReferenceNoInheritOrPortage = + verifyTree (checkUnassignedReferences' True) + "echo $CARGO_INSTALL_PATH" prop_checkUnassignedReferences50 = verifyNotTree checkUnassignedReferences "echo ${foo:+bar}" prop_checkUnassignedReferences51 = verifyNotTree checkUnassignedReferences "echo ${foo:+$foo}" prop_checkUnassignedReferences52 = verifyNotTree checkUnassignedReferences "wait -p pid; echo $pid" @@ -3199,6 +3339,7 @@ checkUncheckedCdPushdPopd params root = [_, str] -> str `matches` regex _ -> False regex = mkRegex "^/*((\\.|\\.\\.)/+)*(\\.|\\.\\.)?$" + exit = if isPortageBuild params then "die" else "exit" prop_checkLoopVariableReassignment1 = verify checkLoopVariableReassignment "for i in *; do for i in *.bar; do true; done; done" prop_checkLoopVariableReassignment2 = verify checkLoopVariableReassignment "for i in *; do for((i=0; i<3; i++)); do true; done; done" @@ -3509,6 +3650,18 @@ prop_checkSplittingInArrays5 = verifyNot checkSplittingInArrays "a=( $! $$ $# )" prop_checkSplittingInArrays6 = verifyNot checkSplittingInArrays "a=( ${#arr[@]} )" prop_checkSplittingInArrays7 = verifyNot checkSplittingInArrays "a=( foo{1,2} )" prop_checkSplittingInArrays8 = verifyNot checkSplittingInArrays "a=( * )" +prop_checkSplittingInArraysUseWith1 = verify checkSplittingInArrays "a=( $(use_with b) )" +prop_checkSplittingInArraysUseWith2 = verifyNot (withPortageParams checkSplittingInArrays) "a=( $(use_with b) )" +prop_checkSplittingInArraysUseEnable1 = verify checkSplittingInArrays "a=( `use_enable b` )" +prop_checkSplittingInArraysUseEnable2 = verifyNot (withPortageParams checkSplittingInArrays) "a=( `use_enable b` )" +prop_checkSplittingInArraysMesonUse1 = verify checkSplittingInArrays "a=( `meson_use b` )" +prop_checkSplittingInArraysMesonUse2 = verifyNot (withPortageParams checkSplittingInArrays) "a=( `meson_use b` )" +prop_checkSplittingInArraysMesonFeature1 = verify checkSplittingInArrays "a=( `meson_feature b` )" +prop_checkSplittingInArraysMesonFeature2 = verifyNot (withPortageParams checkSplittingInArrays) "a=( `meson_feature b` )" +prop_checkSplittingInArraysUsex1 = verify checkSplittingInArrays "a=( $(usex X Y Z) )" +prop_checkSplittingInArraysUsex2 = verify (withPortageParams checkSplittingInArrays) "a=( `usex X \"Y Z\" W` )" +prop_checkSplittingInArraysUsex3 = verify (withPortageParams checkSplittingInArrays) "a=( `usex X \"${VAR}\" W` )" +prop_checkSPlittingInArraysUsex4 = verifyNot (withPortageParams checkSplittingInArrays) "a=( `usex X Y Z` )" checkSplittingInArrays params t = case t of T_Array _ elements -> mapM_ check elements @@ -3518,9 +3671,9 @@ checkSplittingInArrays params t = T_NormalWord _ parts -> mapM_ checkPart parts _ -> return () checkPart part = case part of - T_DollarExpansion id _ -> forCommand id - T_DollarBraceCommandExpansion id _ -> forCommand id - T_Backticked id _ -> forCommand id + T_DollarExpansion id str -> forCommand id part + T_DollarBraceCommandExpansion id str -> forCommand id part + T_Backticked id _ -> forCommand id part T_DollarBraced id _ str | not (isCountingReference part) && not (isQuotedAlternativeReference part) @@ -3531,7 +3684,8 @@ checkSplittingInArrays params t = else "Quote to prevent word splitting/globbing, or split robustly with mapfile or read -a." _ -> return () - forCommand id = + forCommand id t = + unless (commandNeverProducesSpaces params t) $ warn id 2207 $ if shellType params == Ksh then "Prefer read -A or while read to split command output (or quote to avoid splitting)." diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 137c098..b163712 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -27,6 +27,7 @@ import qualified ShellCheck.CFGAnalysis as CF import ShellCheck.Data import ShellCheck.Interface import ShellCheck.Parser +import ShellCheck.PortageVariables import ShellCheck.Prelude import ShellCheck.Regex @@ -102,12 +103,22 @@ data Parameters = Parameters { rootNode :: Token, -- map from token id to start and end position tokenPositions :: Map.Map Id (Position, Position), + -- detailed type of any Portage related file + portageFileType :: PortageFileType, + -- Gentoo-specific data + gentooData :: EclassMap, -- Result from Control Flow Graph analysis (including data flow analysis) cfgAnalysis :: CF.CFGAnalysis, -- A set of additional variables known to be set (TODO: make this more general?) additionalKnownVariables :: [String] } deriving (Show) +isPortageBuild :: Parameters -> Bool +isPortageBuild params = portageFileType params /= NonPortageRelated + +isPortage9999Ebuild :: Parameters -> Bool +isPortage9999Ebuild params = portageFileType params == Ebuild { is9999Ebuild = True } + -- TODO: Cache results of common AST ops here data Cache = Cache {} @@ -148,6 +159,15 @@ pScript s = } in runIdentity $ parseScript (mockedSystemInterface []) pSpec +-- For testing. Tries to construct Parameters from a test script allowing for +-- alterations to the AnalysisSpec. +makeTestParams :: String -> (AnalysisSpec -> AnalysisSpec) -> Maybe Parameters +makeTestParams s specModifier = do + let pr = pScript s + prRoot pr + let spec = specModifier $ defaultSpec pr + return $ makeParameters spec + -- For testing. If parsed, returns whether there are any comments producesComments :: Checker -> String -> Maybe Bool producesComments c s = do @@ -597,6 +617,15 @@ getReferencedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Litera head:_ -> map (\x -> (base, head, x)) $ getVariablesFromLiteralToken head _ -> [] "alias" -> [(base, token, name) | token <- rest, name <- getVariablesFromLiteralToken token] + + -- tc-export makes a list of toolchain variables available, similar to export. + -- Usage tc-export CC CXX + "tc-export" -> concatMap getReference rest + + -- tc-export_build_env exports the listed variables plus a bunch of BUILD_XX variables. + -- Usage tc-export_build_env BUILD_CC + "tc-export_build_env" -> concatMap getReference rest ++ concatMap buildVarReferences portageBuildFlagVariables + _ -> [] where forDeclare = @@ -610,6 +639,7 @@ getReferencedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Litera getReference t@(T_NormalWord _ [T_Literal _ name]) | not ("-" `isPrefixOf` name) = [(t, t, name)] getReference _ = [] flags = map snd $ getAllFlags base + buildVarReferences var = [(base, base, "BUILD_" ++ var), (base, base, var ++ "_FOR_BUILD")] getReferencedVariableCommand _ = [] @@ -668,6 +698,13 @@ getModifiedVariableCommand base@(T_SimpleCommand id cmdPrefix (T_NormalWord _ (T "DEFINE_integer" -> maybeToList $ getFlagVariable rest "DEFINE_string" -> maybeToList $ getFlagVariable rest + -- tc-export creates all the variables passed to it + "tc-export" -> concatMap getModifierParamString rest + + -- tc-export_build_env creates all the variables passed to it + -- plus several BUILD_ and _FOR_BUILD variables. + "tc-export_build_env" -> concatMap getModifierParamString rest ++ getBuildEnvTokens + _ -> [] where flags = map snd $ getAllFlags base @@ -758,6 +795,10 @@ getModifiedVariableCommand base@(T_SimpleCommand id cmdPrefix (T_NormalWord _ (T return (base, n, "FLAGS_" ++ name, DataString $ SourceExternal) getFlagVariable _ = Nothing + getBuildEnvTokens = concatMap buildVarTokens portageBuildFlagVariables + buildVarTokens var = [(base, base, "BUILD_" ++ var, DataString $ SourceExternal), + (base, base, var ++ "_FOR_BUILD", DataString $ SourceExternal)] + getModifiedVariableCommand _ = [] -- Given a NormalWord like foo or foo[$bar], get foo. diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index 0d95e86..f3738e7 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -200,7 +200,7 @@ unreachableState = modified newInternalState { createEnvironmentState :: CFGParameters -> InternalState createEnvironmentState params = do foldl' (flip ($)) newInternalState $ concat [ - addVars Data.internalVariables unknownVariableState, + addVars Data.genericInternalVariables unknownVariableState, addVars Data.variablesWithoutSpaces spacelessVariableState, addVars Data.specialIntegerVariables integerVariableState, addVars (cfAdditionalInitialVariables params) unknownVariableState diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index 513390a..3d708ae 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -54,7 +54,9 @@ shellFromFilename filename = listToMaybe candidates shellExtensions = [(".ksh", Ksh) ,(".bash", Bash) ,(".bats", Bash) - ,(".dash", Dash)] + ,(".dash", Dash) + ,(".ebuild", Bash) + ,(".eclass", Bash)] -- The `.sh` is too generic to determine the shell: -- We fallback to Bash in this case and emit SC2148 if there is no shebang candidates = @@ -86,7 +88,9 @@ checkScript sys spec = do asCheckSourced = csCheckSourced spec, asExecutionMode = Executed, asTokenPositions = tokenPositions, - asOptionalChecks = getEnableDirectives root ++ csOptionalChecks spec + asOptionalChecks = getEnableDirectives root ++ csOptionalChecks spec, + asPortageFileType = getPortageFileType $ csFilename spec, + asGentooData = csGentooData spec } where as = newAnalysisSpec root let getAnalysisMessages = case prRoot result of diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 691836f..03911e0 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -60,8 +60,32 @@ verify :: CommandCheck -> String -> Bool verify f s = producesComments (getChecker [f]) s == Just True verifyNot f s = producesComments (getChecker [f]) s == Just False -commandChecks :: [CommandCheck] -commandChecks = [ +verifyDisabledCheckerInPortage :: String -> Bool +verifyDisabledCheckerInPortage = verifyDisabledCheckerInPortage2 $ + Ebuild { is9999Ebuild = True } + +verifyDisabledCheckerInPortage2 :: PortageFileType -> String -> Bool +verifyDisabledCheckerInPortage2 portageFileType s = fromMaybe False $ do + params <- makeTestParams s portageTypeSpec + testSpec <- makeTestSpec + return $ null $ runChecker params (checker testSpec params) + where + portageTypeSpec spec = spec { + asPortageFileType = portageFileType + } + makeTestSpec = do + let pr = pScript s + prRoot pr + return $ portageTypeSpec $ defaultSpec pr + + +commandCheckWhen :: Bool -> CommandCheck -> CommandCheck +commandCheckWhen predicate commandCheck = if predicate + then commandCheck + else CommandCheck (Exactly "skipped") nullCheck + +commandChecks :: Parameters -> [CommandCheck] +commandChecks params = [ checkTr ,checkFindNameGlob ,checkExpr @@ -84,7 +108,7 @@ commandChecks = [ ,checkAliasesUsesArgs ,checkAliasesExpandEarly ,checkUnsetGlobs - ,checkFindWithoutPath + ,commandCheckWhen (not $ isPortageBuild params) checkFindWithoutPath ,checkTimeParameters ,checkTimedCommand ,checkLocalScope @@ -92,7 +116,7 @@ commandChecks = [ ,checkDeprecatedEgrep ,checkDeprecatedFgrep ,checkWhileGetoptsCase - ,checkCatastrophicRm + ,checkCatastrophicRm (isPortageBuild params) ,checkLetUsage ,checkMvArguments, checkCpArguments, checkLnArguments ,checkFindRedirections @@ -206,7 +230,7 @@ getChecker list = Checker { checker :: AnalysisSpec -> Parameters -> Checker -checker spec params = getChecker $ commandChecks ++ optionals +checker spec params = getChecker $ (commandChecks params) ++ optionals where keys = asOptionalChecks spec optionals = @@ -893,6 +917,7 @@ prop_checkFindWithoutPath5 = verifyNot checkFindWithoutPath "find -O3 ." prop_checkFindWithoutPath6 = verifyNot checkFindWithoutPath "find -D exec ." prop_checkFindWithoutPath7 = verifyNot checkFindWithoutPath "find --help" prop_checkFindWithoutPath8 = verifyNot checkFindWithoutPath "find -Hx . -print" +prop_checkFindWithoutPathPortage = verifyDisabledCheckerInPortage "find -type f" checkFindWithoutPath = CommandCheck (Basename "find") f where f t@(T_SimpleCommand _ _ (cmd:args)) = @@ -1071,20 +1096,23 @@ checkWhileGetoptsCase = CommandCheck (Exactly "getopts") f T_Redirecting _ _ x@(T_CaseExpression {}) -> return x _ -> Nothing -prop_checkCatastrophicRm1 = verify checkCatastrophicRm "rm -r $1/$2" -prop_checkCatastrophicRm2 = verify checkCatastrophicRm "rm -r /home/$foo" -prop_checkCatastrophicRm3 = verifyNot checkCatastrophicRm "rm -r /home/${USER:?}/*" -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_checkCatastrophicRmA = verify checkCatastrophicRm "rm -rf /usr /lib/nvidia-current/xorg/xorg" -prop_checkCatastrophicRmB = verify checkCatastrophicRm "rm -rf \"$STEAMROOT/\"*" -checkCatastrophicRm = CommandCheck (Basename "rm") $ \t -> +prop_checkCatastrophicRm1 = verify (checkCatastrophicRm False) "rm -r $1/$2" +prop_checkCatastrophicRm2 = verify (checkCatastrophicRm False) "rm -r /home/$foo" +prop_checkCatastrophicRm3 = verifyNot (checkCatastrophicRm False) "rm -r /home/${USER:?}/*" +prop_checkCatastrophicRm4 = verify (checkCatastrophicRm False) "rm -fr /home/$(whoami)/*" +prop_checkCatastrophicRm5 = verifyNot (checkCatastrophicRm False) "rm -r /home/${USER:-thing}/*" +prop_checkCatastrophicRm6 = verify (checkCatastrophicRm False) "rm --recursive /etc/*$config*" +prop_checkCatastrophicRm8 = verify (checkCatastrophicRm False) "rm -rf /home" +prop_checkCatastrophicRm10 = verifyNot (checkCatastrophicRm False) "rm -r \"${DIR}\"/{.gitignore,.gitattributes,ci}" +prop_checkCatastrophicRm11 = verify (checkCatastrophicRm False) "rm -r /{bin,sbin}/$exec" +prop_checkCatastrophicRm12 = verify (checkCatastrophicRm False) "rm -r /{{usr,},{bin,sbin}}/$exec" +prop_checkCatastrophicRm13 = verifyNot (checkCatastrophicRm False) "rm -r /{{a,b},{c,d}}/$exec" +prop_checkCatastrophicRmA = verify (checkCatastrophicRm False) "rm -rf /usr /lib/nvidia-current/xorg/xorg" +prop_checkCatastrophicRmB = verify (checkCatastrophicRm False) "rm -rf \"$STEAMROOT/\"*" +prop_checkCatastrophicRmED1 = verify (checkCatastrophicRm False) "rm -rf \"$ED/var/\"*" +prop_checkCatastrophicRmED2 = verifyNot (checkCatastrophicRm True) "rm -rf \"$ED/var/\"*" +checkCatastrophicRm isPortageBuild = CommandCheck (Basename "rm") $ \t -> + when (isRecursive t) $ mapM_ (mapM_ checkWord . braceExpand) $ arguments t where @@ -1114,7 +1142,7 @@ checkCatastrophicRm = CommandCheck (Basename "rm") $ \t -> f (T_DollarBraced _ _ word) = let var = onlyLiteralString word in -- This shouldn't handle non-colon cases. - if any (`isInfixOf` var) [":?", ":-", ":="] + if any (`isInfixOf` var) [":?", ":-", ":="] || (isPortageBuild && var `elem` ["D", "ED"]) then Nothing else return "" f _ = return "" @@ -1339,6 +1367,7 @@ checkMaskedReturns str = CommandCheck (Exactly str) checkCmd checkCmd t = do path <- getPathM t shell <- asks shellType + portageFileType <- asks portageFileType sequence_ $ do name <- getCommandName t @@ -1349,10 +1378,11 @@ checkMaskedReturns str = CommandCheck (Exactly str) checkCmd let isLocal = not hasDashG && isLocalInFunction name && isInScopedFunction let isReadOnly = name == "readonly" || hasDashR + let isPortageBuild = portageFileType /= NonPortageRelated -- Don't warn about local variables that are declared readonly, -- because the workaround `local x; x=$(false); local -r x;` is annoying - guard . not $ isLocal && isReadOnly + guard . not $ isLocal && isReadOnly || isPortageBuild return $ mapM_ checkArgs $ arguments t diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 550ff87..644c2f9 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -1,6 +1,8 @@ module ShellCheck.Data where +import qualified Data.Map import ShellCheck.Interface +import ShellCheck.PortageVariables import Data.Version (showVersion) @@ -23,8 +25,8 @@ Use: import Paths_ShellCheck (version) shellcheckVersion = showVersion version -- VERSIONSTRING - -internalVariables = [ +genericInternalVariables :: [String] +genericInternalVariables = [ -- Generic "", "_", "rest", "REST", @@ -55,15 +57,109 @@ internalVariables = [ "USER", "TZ", "TERM", "LOGNAME", "LD_LIBRARY_PATH", "LANGUAGE", "DISPLAY", "HOSTNAME", "KRB5CCNAME", "XAUTHORITY" - -- Ksh - , ".sh.version" - -- shflags , "FLAGS_ARGC", "FLAGS_ARGV", "FLAGS_ERROR", "FLAGS_FALSE", "FLAGS_HELP", "FLAGS_PARENT", "FLAGS_RESERVED", "FLAGS_TRUE", "FLAGS_VERSION", "flags_error", "flags_return" ] +kshInternalVariables = [ + ".sh.version" + ] + +portageManualInternalVariables = [ + -- toolchain settings + "CFLAGS", "CXXFLAGS", "CPPFLAGS", "LDFLAGS", "FFLAGS", "FCFLAGS", + "CBUILD", "CHOST", "MAKEOPTS" + -- TODO: Delete these if we can handle `tc-export CC` implicit export. + , "CC", "CPP", "CXX" + + -- portage internals + , "EBUILD_PHASE", "EBUILD_SH_ARGS", "EMERGE_FROM", "FILESDIR", + "MERGE_TYPE", "PM_EBUILD_HOOK_DIR", "PORTAGE_ACTUAL_DISTDIR", + "PORTAGE_ARCHLIST", "PORTAGE_BASHRC", "PORTAGE_BINPKG_FILE", + "PORTAGE_BINPKG_TAR_OPTS", "PORTAGE_BINPKG_TMPFILE", "PORTAGE_BIN_PATH", + "PORTAGE_BUILDDIR", "PORTAGE_BUILD_GROUP", "PORTAGE_BUILD_USER", + "PORTAGE_BUNZIP2_COMMAND", "PORTAGE_BZIP2_COMMAND", "PORTAGE_COLORMAP", + "PORTAGE_CONFIGROOT", "PORTAGE_DEBUG", "PORTAGE_DEPCACHEDIR", + "PORTAGE_EBUILD_EXIT_FILE", "PORTAGE_ECLASS_LOCATIONS", "PORTAGE_GID", + "PORTAGE_GRPNAME", "PORTAGE_INST_GID", "PORTAGE_INST_UID", + "PORTAGE_INTERNAL_CALLER", "PORTAGE_IPC_DAEMON", "PORTAGE_IUSE", + "PORTAGE_LOG_FILE", "PORTAGE_MUTABLE_FILTERED_VARS", + "PORTAGE_OVERRIDE_EPREFIX", "PORTAGE_PYM_PATH", "PORTAGE_PYTHON", + "PORTAGE_PYTHONPATH", "PORTAGE_READONLY_METADATA", "PORTAGE_READONLY_VARS", + "PORTAGE_REPO_NAME", "PORTAGE_REPOSITORIES", "PORTAGE_RESTRICT", + "PORTAGE_SAVED_READONLY_VARS", "PORTAGE_SIGPIPE_STATUS", "PORTAGE_TMPDIR", + "PORTAGE_UPDATE_ENV", "PORTAGE_USERNAME", "PORTAGE_VERBOSE", + "PORTAGE_WORKDIR_MODE", "PORTAGE_XATTR_EXCLUDE", "REPLACING_VERSIONS", + "REPLACED_BY_VERSION", "__PORTAGE_HELPER", "__PORTAGE_TEST_HARDLINK_LOCKS", + + -- generic ebuilds + "A", "ARCH", "BDEPEND", "BOARD_USE", "BROOT", "CATEGORY", "D", + "DEFINED_PHASES", "DEPEND", "DESCRIPTION", "DISTDIR", "DOCS", "EAPI", + "ECLASS", "ED", "EPREFIX", "EROOT", "ESYSROOT", "EXTRA_ECONF", + "EXTRA_EINSTALL", "EXTRA_MAKE", "FEATURES", "FILESDIR", "HOME", "HOMEPAGE", + "HTML_DOCS", "INHERITED", "IUSE", "KEYWORDS", "LICENSE", "P", "PATCHES", + "PDEPEND", "PF", "PKG_INSTALL_MASK", "PKGUSE", "PN", "PR", "PROPERTIES", + "PROVIDES_EXCLUDE", "PV", "PVR", "QA_AM_MAINTAINER_MODE", + "QA_CONFIGURE_OPTIONS", "QA_DESKTOP_FILE", "QA_DT_NEEDED", "QA_EXECSTACK", + "QA_FLAGS_IGNORED", "QA_MULTILIB_PATHS", "QA_PREBUILT", "QA_PRESTRIPPED", + "QA_SONAME", "QA_SONAME_NO_SYMLINK", "QA_TEXTRELS", "QA_WX_LOAD", "RDEPEND", + "REPOSITORY", "REQUIRED_USE", "REQUIRES_EXCLUDE", "RESTRICT", "ROOT", "S", + "SLOT", "SRC_TEST", "SRC_URI", "STRIP_MASK", "SUBSLOT", "SYSROOT", "T", + "WORKDIR", + + -- autotest.eclass declared incorrectly + "AUTOTEST_CLIENT_TESTS", "AUTOTEST_CLIENT_SITE_TESTS", + "AUTOTEST_SERVER_TESTS", "AUTOTEST_SERVER_SITE_TESTS", "AUTOTEST_CONFIG", + "AUTOTEST_DEPS", "AUTOTEST_PROFILERS", "AUTOTEST_CONFIG_LIST", + "AUTOTEST_DEPS_LIST", "AUTOTEST_PROFILERS_LIST", + + -- cros-board.eclass declared incorrectly + "CROS_BOARDS", + + -- Undeclared cros-kernel2 vars + "AFDO_PROFILE_VERSION", + + -- haskell-cabal.eclass declared incorrectly + "CABAL_FEATURES", + + -- Undeclared haskell-cabal.eclass vars + "CABAL_CORE_LIB_GHC_PV", + + -- Undeclared readme.gentoo.eclass vars + "DOC_CONTENTS", + + -- Backwards compatibility perl-module.eclass vars + "MODULE_AUTHOR", "MODULE_VERSION", + + -- Undeclared perl-module.eclass vars + "mydoc", + + -- python-utils-r1.eclass declared incorrectly + "RESTRICT_PYTHON_ABIS", "PYTHON_MODNAME", + + -- ABI variables + "ABI", "DEFAULT_ABI", + + -- AFDO variables + "AFDO_LOCATION", + + -- Linguas + "LINGUAS" + ] + +eclassVarsFromMap :: EclassMap -> String -> [String] +eclassVarsFromMap gMap eclass = + Data.Map.findWithDefault [] + eclass + (Data.Map.map (map decodeLenient) gMap) + +portageInternalVariables :: [String] -> EclassMap -> [String] +portageInternalVariables inheritedEclasses gMap = + portageManualInternalVariables ++ concatMap (eclassVarsFromMap gMap) + inheritedEclasses + specialIntegerVariables = [ "$", "?", "!", "#" ] @@ -81,18 +177,30 @@ variablesWithoutSpaces = specialVariablesWithoutSpaces ++ [ , "FLAGS_ERROR", "FLAGS_FALSE", "FLAGS_TRUE" ] +portageVariablesWithoutSpaces = [ + "EAPI", "P", "PF", "PN", "PR", "PV", "PVR", "SLOT" + ] + specialVariables = specialVariablesWithoutSpaces ++ ["@", "*"] unbracedVariables = specialVariables ++ [ "0", "1", "2", "3", "4", "5", "6", "7", "8", "9" ] -arrayVariables = [ +shellArrayVariables = [ "BASH_ALIASES", "BASH_ARGC", "BASH_ARGV", "BASH_CMDS", "BASH_LINENO", "BASH_REMATCH", "BASH_SOURCE", "BASH_VERSINFO", "COMP_WORDS", "COPROC", "DIRSTACK", "FUNCNAME", "GROUPS", "MAPFILE", "PIPESTATUS", "COMPREPLY" ] +portageArrayVariables = [ + "PATCHES" + ] + +portageBuildFlagVariables = [ + "CFLAGS", "CXXFLAGS", "CPPFLAGS", "LDFLAGS" + ] + commonCommands = [ "admin", "alias", "ar", "asa", "at", "awk", "basename", "batch", "bc", "bg", "break", "c99", "cal", "cat", "cd", "cflow", "chgrp", diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index 1329a4d..bc258ed 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, csOptionalChecks, csGentooData) , 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, asOptionalChecks, asPortageFileType, asGentooData) , AnalysisResult(arComments) , FormatterOptions(foColorOption, foWikiLinkCount) , Shell(Ksh, Sh, Bash, Dash) @@ -59,9 +59,12 @@ module ShellCheck.Interface , newReplacement , CheckDescription(cdName, cdDescription, cdPositive, cdNegative) , newCheckDescription + , PortageFileType(NonPortageRelated, Ebuild, is9999Ebuild, Eclass) + , getPortageFileType ) where import ShellCheck.AST +import ShellCheck.PortageVariables (EclassMap) import Control.DeepSeq import Control.Monad.Identity @@ -102,7 +105,8 @@ data CheckSpec = CheckSpec { csIncludedWarnings :: Maybe [Integer], csShellTypeOverride :: Maybe Shell, csMinSeverity :: Severity, - csOptionalChecks :: [String] + csOptionalChecks :: [String], + csGentooData :: EclassMap } deriving (Show, Eq) data CheckResult = CheckResult { @@ -126,7 +130,8 @@ emptyCheckSpec = CheckSpec { csIncludedWarnings = Nothing, csShellTypeOverride = Nothing, csMinSeverity = StyleC, - csOptionalChecks = [] + csOptionalChecks = [], + csGentooData = Map.empty } newParseSpec :: ParseSpec @@ -169,6 +174,20 @@ newParseResult = ParseResult { prRoot = Nothing } +data PortageFileType = NonPortageRelated + | Ebuild { is9999Ebuild :: Bool } + | Eclass deriving (Show, Eq) + +getPortageFileType :: String -> PortageFileType +getPortageFileType filename + | ".ebuild" `isSuffixOf` filename = ebuildType + | ".eclass" `isSuffixOf` filename = Eclass + | otherwise = NonPortageRelated + where + ebuildType = Ebuild { + is9999Ebuild = "-9999.ebuild" `isSuffixOf` filename + } + -- Analyzer input and output data AnalysisSpec = AnalysisSpec { asScript :: Token, @@ -177,7 +196,9 @@ data AnalysisSpec = AnalysisSpec { asExecutionMode :: ExecutionMode, asCheckSourced :: Bool, asOptionalChecks :: [String], - asTokenPositions :: Map.Map Id (Position, Position) + asTokenPositions :: Map.Map Id (Position, Position), + asPortageFileType :: PortageFileType, + asGentooData :: EclassMap } newAnalysisSpec token = AnalysisSpec { @@ -187,7 +208,9 @@ newAnalysisSpec token = AnalysisSpec { asExecutionMode = Executed, asCheckSourced = False, asOptionalChecks = [], - asTokenPositions = Map.empty + asTokenPositions = Map.empty, + asPortageFileType = NonPortageRelated, + asGentooData = Map.empty } newtype AnalysisResult = AnalysisResult { diff --git a/src/ShellCheck/PortageVariables.hs b/src/ShellCheck/PortageVariables.hs new file mode 100644 index 0000000..3c6f611 --- /dev/null +++ b/src/ShellCheck/PortageVariables.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +module ShellCheck.PortageVariables + ( RepoName + , RepoPath + , EclassName + , EclassVar + , EclassMap + , Repository(..) + , Eclass(..) + , portageVariables + , scanRepos + , decodeLenient + ) where + +import Control.Applicative +import Control.Exception (bracket) +import Control.Monad +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe +import Data.Attoparsec.ByteString +import qualified Data.Attoparsec.ByteString as A +import Data.Attoparsec.ByteString.Char8 hiding (takeWhile) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Char (ord) +import qualified Data.Map as M +import Data.Maybe (fromJust) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Encoding.Error as T +import System.Directory (listDirectory) +import System.Exit (ExitCode(..)) +import System.FilePath +import System.IO (hClose) +import System.Process + +import Prelude hiding (takeWhile) + +type RepoName = ByteString +type RepoPath = ByteString +type EclassName = String +type EclassVar = ByteString + +-- | This is used for looking up what eclass variables are inherited, +-- keyed by the name of the eclass. +type EclassMap = M.Map EclassName [EclassVar] + +data Repository = Repository + { repositoryName :: RepoName + , repositoryLocation :: RepoPath + , repositoryEclasses :: [Eclass] + } deriving (Show, Eq, Ord) + +data Eclass = Eclass + { eclassName :: EclassName + , eclassVars :: [EclassVar] + } deriving (Show, Eq, Ord) + +-- | Map from eclass names to a list of eclass variables +portageVariables :: [Repository] -> EclassMap +portageVariables = foldMap $ foldMap go . repositoryEclasses + where + go e = M.singleton (eclassName e) (eclassVars e) + +-- | Run @portageq@ to gather a list of repo names and paths, then scan each +-- one for eclasses and ultimately eclass metadata. +scanRepos :: IO [Repository] +scanRepos = do + let cmd = "/usr/bin/portageq" + let args = ["repos_config", "/"] + out <- runOrDie cmd args + case parseOnly reposParser out of + Left pe -> fail $ show pe + Right nps -> do + forM nps $ \(n,p) -> Repository n p <$> getEclasses p + +-- | Get the name of the repo and its path from blocks outputted by +-- @portageq@. If the path doesn't exist, this will return @Nothing@. +reposParser :: Parser [(RepoName, RepoPath)] +reposParser = + choice + [ [] <$ endOfInput + , repoName >>= repoBlock + ] + where + -- Get the name of the repo at the top of the block + repoName :: Parser RepoName + repoName = do + _ <- char '[' + n <- takeWhile (/= fromIntegral (ord ']')) + _ <- char ']' + _ <- endOfLine + pure n + + -- Parse the block for location field + repoBlock :: RepoName -> Parser [(RepoName, RepoPath)] + repoBlock n = choice + [ do + l <- "location = " *> takeLine + -- Found the location, skip the rest of the block + skipMany miscLine *> endOfBlock + insert (n,l) + -- Did not find the location, keep trying + , miscLine *> repoBlock n + -- Reached the end of the block, no location field + , endOfBlock *> ignore + ] + + miscLine :: Parser () + miscLine = skipNonEmptyLine + + -- A block either ends with an empty line or eof + endOfBlock :: Parser () + endOfBlock = endOfLine <|> endOfInput + + -- cons the repo and continue parsing + insert :: (RepoName, RepoPath) -> Parser [(RepoName, RepoPath)] + insert r = (r:) <$> reposParser + + -- skip the repo and continue parsing + ignore :: Parser [(RepoName, RepoPath)] + ignore = reposParser + +-- | Scan the repo path for @*.eclass@ files in @eclass/@, then run +-- 'eclassParser' on each of them to produce @[Eclass]@. +-- +-- If the @eclass/@ directory doesn't exist, the scan is skipped for that +-- repo. +getEclasses :: RepoPath -> IO [Eclass] +getEclasses repoLoc = fmap (maybe [] id) $ runMaybeT $ do + let eclassDir = (decodeLenient repoLoc) "eclass" + + -- Silently fail if the repo doesn't have an eclass dir + fs <- MaybeT $ Just <$> listDirectory eclassDir <|> pure Nothing + let fs' = filter (\(_,e) -> e == ".eclass") $ map splitExtensions fs + + forM fs' $ \(n,e) -> do + evs <- lift $ parseFromFile eclassParser (eclassDir n <.> e) + case evs of + Left pe -> lift $ fail $ show pe + Right vs -> pure $ Eclass n vs + +-- | Scan a @.eclass@ file for any @@@ECLASS_VARIABLE:@ comments, generating +-- a list of eclass variables. +eclassParser :: Parser [EclassVar] +eclassParser = choice + [ -- cons the EclassVar to the list and continue + liftA2 (:) eclassVar eclassParser + -- or skip the line and continue + , skipLine *> eclassParser + -- or end the list on eof + , [] <$ endOfInput + ] + where + -- Scans for @ECLASS_VARIABLE comments rather than parsing the raw bash + eclassVar :: Parser EclassVar + eclassVar = "# @ECLASS_VARIABLE: " *> takeLine + +takeLine :: Parser ByteString +takeLine = A.takeWhile (not . isEndOfLine) <* endOfLine + +-- | Fails if next char is 'endOfLine' +skipNonEmptyLine :: Parser () +skipNonEmptyLine = A.satisfy (not . isEndOfLine) *> skipLine + +skipLine :: Parser () +skipLine = A.skipWhile (not . isEndOfLine) <* endOfLine + +parseFromFile :: Parser a -> FilePath -> IO (Either String a) +parseFromFile p = fmap (parseOnly p) . B.readFile + +-- | Run the command and return the full stdout string (stdin is ignored). +-- +-- If the command exits with a non-zero exit code, this will throw an +-- error including the captured contents of stdout and stderr. +runOrDie :: FilePath -> [String] -> IO ByteString +runOrDie cmd args = bracket acquire release $ \(_,o,e,p) -> do + ot <- B.hGetContents (fromJust o) + et <- B.hGetContents (fromJust e) + ec <- waitForProcess p + case ec of + ExitSuccess -> pure ot + ExitFailure i -> fail $ unlines $ map unwords + $ [ [ show cmd ] + ++ map show args + ++ [ "failed with exit code", show i] + , [ "stdout:" ], [ decodeLenient ot ] + , [ "stderr:" ], [ decodeLenient et ] + ] + where + acquire = createProcess (proc cmd args) + { std_in = NoStream + , std_out = CreatePipe + , std_err = CreatePipe + } + release (i,o,e,p) = do + _ <- waitForProcess p + forM_ [i,o,e] $ mapM_ hClose + +decodeLenient :: ByteString -> String +decodeLenient = T.unpack . T.decodeUtf8With T.lenientDecode