diff --git a/shellcheck.hs b/shellcheck.hs index 09176a5..716e36d 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -241,22 +241,10 @@ 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, - csGentooData = gentooData + csScript = contents } - result <- checkScript sys checkspec onResult format result sys return $ @@ -542,13 +530,16 @@ ioInterface options files = do x <- readIORef cache case x of Just m -> do - hPutStrLn stderr "Reusing previous Portage variables" return m Nothing -> do - hPutStrLn stderr "Computing Portage variables" - vars <- return $ Map.fromList [("foo", ["bar", "baz"])] -- TODO: Actually read the variables + vars <- readPortageVariables `catch` handler writeIORef cache $ Just vars return vars + where + handler :: IOException -> IO (Map.Map String [String]) + handler e = do + hPutStrLn stderr $ "Error finding portage repos, eclass definitions will be ignored: " ++ show e + return $ Map.empty inputFile file = do (handle, shouldCache) <- diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 1523da7..58c3310 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -68,7 +68,6 @@ treeChecks = [ ,checkArrayAssignmentIndices ,checkUseBeforeDefinition ,checkAliasUsedInSameParsingUnit - ,checkForStableKeywordsin9999CrosWorkonEbuilds ,checkArrayValueUsedAsIndex ] @@ -292,12 +291,6 @@ 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 () @@ -785,33 +778,6 @@ 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`" @@ -824,11 +790,6 @@ 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 = @@ -840,7 +801,7 @@ checkUnquotedExpansions params = check _ = return () tree = parentMap params examine t contents = - unless (null contents || shouldBeSplit t || isQuoteFree (shellType params) tree t || usedAsCommandName tree t || commandNeverProducesSpaces params t) $ + unless (null contents || shouldBeSplit t || isQuoteFree (shellType params) tree t || usedAsCommandName tree t) $ warn (getId t) 2046 "Quote this to prevent word splitting." shouldBeSplit t = @@ -1002,10 +963,6 @@ 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" @@ -1021,7 +978,6 @@ 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 @@ -1114,9 +1070,6 @@ 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) = @@ -1156,9 +1109,6 @@ 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 @@ -2086,47 +2036,6 @@ 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 = @@ -2408,16 +2317,6 @@ 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;" @@ -2467,26 +2366,6 @@ 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" @@ -2513,8 +2392,7 @@ checkUnusedAssignments params t = execWriter (mapM_ warnFor unused) name ++ " appears unused. Verify use (or export if used externally)." stripSuffix = takeWhile isVariableChar - defaultMap = Map.fromList $ zip internalVariables $ repeat () - internalVariables = allInternalVariables params + defaultMap = Map.fromList $ zip (internalVariables ++ additionalKnownVariables params) $ repeat () prop_checkUnassignedReferences1 = verifyTree checkUnassignedReferences "echo $foo" prop_checkUnassignedReferences2 = verifyNotTree checkUnassignedReferences "foo=hello; echo $foo" @@ -2565,24 +2443,6 @@ 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" @@ -3339,7 +3199,6 @@ 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" @@ -3650,18 +3509,6 @@ 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 @@ -3671,9 +3518,9 @@ checkSplittingInArrays params t = T_NormalWord _ parts -> mapM_ checkPart parts _ -> return () checkPart part = case part of - T_DollarExpansion id str -> forCommand id part - T_DollarBraceCommandExpansion id str -> forCommand id part - T_Backticked id _ -> forCommand id part + T_DollarExpansion id _ -> forCommand id + T_DollarBraceCommandExpansion id _ -> forCommand id + T_Backticked id _ -> forCommand id T_DollarBraced id _ str | not (isCountingReference part) && not (isQuotedAlternativeReference part) @@ -3684,8 +3531,7 @@ checkSplittingInArrays params t = else "Quote to prevent word splitting/globbing, or split robustly with mapfile or read -a." _ -> return () - forCommand id t = - unless (commandNeverProducesSpaces params t) $ + forCommand id = 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 b163712..3ceb245 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -27,7 +27,6 @@ import qualified ShellCheck.CFGAnalysis as CF import ShellCheck.Data import ShellCheck.Interface import ShellCheck.Parser -import ShellCheck.PortageVariables import ShellCheck.Prelude import ShellCheck.Regex @@ -89,6 +88,8 @@ data Parameters = Parameters { hasSetE :: Bool, -- Whether this script has 'set -o pipefail' anywhere. hasPipefail :: Bool, + -- Whether this script is an Ebuild file. + isPortage :: Bool, -- A linear (bad) analysis of data flow variableFlow :: [StackData], -- A map from Id to Token @@ -103,21 +104,12 @@ 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 {} @@ -159,15 +151,6 @@ 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 @@ -221,11 +204,14 @@ makeCommentWithFix severity id code str fix = makeParameters :: Monad m => SystemInterface m -> AnalysisSpec -> m Parameters makeParameters sys spec = do extraVars <- - case shell of - Bash -> do -- TODO: EBuild type - vars <- siGetPortageVariables sys - return $ Map.findWithDefault [] "foo" vars -- TODO: Determine what to look up in map - _ -> return [] + if asIsPortage spec + then do + vars <- siGetPortageVariables sys + let classes = getInheritedEclasses root + return $ concatMap (\c -> Map.findWithDefault [] c vars) classes + else + return [] + return $ makeParams extraVars where shell = fromMaybe (determineShell (asFallbackShell spec) root) $ asShellType spec @@ -254,6 +240,7 @@ makeParameters sys spec = do Sh -> True Ksh -> isOptionSet "pipefail" root, shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec), + isPortage = asIsPortage spec, idMap = getTokenMap root, parentMap = getParentTree root, variableFlow = getVariableFlow params root, @@ -617,15 +604,6 @@ 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 = @@ -639,7 +617,6 @@ 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 _ = [] @@ -698,13 +675,6 @@ 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 @@ -795,10 +765,6 @@ 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. @@ -974,6 +940,13 @@ modifiesVariable params token name = Assignment (_, _, n, source) -> isTrueAssignmentSource source && n == name _ -> False +-- Ebuild files inherit eclasses using 'inherit myclass1 myclass2' +getInheritedEclasses :: Token -> [String] +getInheritedEclasses root = execWriter $ doAnalysis findInheritedEclasses root + where + findInheritedEclasses cmd + | cmd `isCommand` "inherit" = tell $ catMaybes $ getLiteralString <$> (arguments cmd) + findInheritedEclasses _ = return () return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index f3738e7..0d95e86 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.genericInternalVariables unknownVariableState, + addVars Data.internalVariables 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 3d708ae..2726f48 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 Data.Char import Data.Either import Data.Functor import Data.List @@ -54,9 +55,9 @@ shellFromFilename filename = listToMaybe candidates shellExtensions = [(".ksh", Ksh) ,(".bash", Bash) ,(".bats", Bash) - ,(".dash", Dash) ,(".ebuild", Bash) - ,(".eclass", Bash)] + ,(".eclass", Bash) + ,(".dash", Dash)] -- 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,11 +87,10 @@ checkScript sys spec = do asShellType = csShellTypeOverride spec, asFallbackShell = shellFromFilename $ csFilename spec, asCheckSourced = csCheckSourced spec, + asIsPortage = isPortage $ csFilename spec, asExecutionMode = Executed, asTokenPositions = tokenPositions, - asOptionalChecks = getEnableDirectives root ++ csOptionalChecks spec, - asPortageFileType = getPortageFileType $ csFilename spec, - asGentooData = csGentooData spec + asOptionalChecks = getEnableDirectives root ++ csOptionalChecks spec } where as = newAnalysisSpec root let getAnalysisMessages = case prRoot result of @@ -101,6 +101,10 @@ checkScript sys spec = do return . nub . sortMessages . filter shouldInclude $ (parseMessages ++ map translator analysisMessages) + isPortage filename = + let f = map toLower filename in + ".ebuild" `isSuffixOf` f || ".eclass" `isSuffixOf` f + shouldInclude pc = severity <= csMinSeverity spec && case csIncludedWarnings spec of diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 03911e0..691836f 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -60,32 +60,8 @@ verify :: CommandCheck -> String -> Bool verify f s = producesComments (getChecker [f]) s == Just True verifyNot f s = producesComments (getChecker [f]) s == Just False -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 = [ +commandChecks :: [CommandCheck] +commandChecks = [ checkTr ,checkFindNameGlob ,checkExpr @@ -108,7 +84,7 @@ commandChecks params = [ ,checkAliasesUsesArgs ,checkAliasesExpandEarly ,checkUnsetGlobs - ,commandCheckWhen (not $ isPortageBuild params) checkFindWithoutPath + ,checkFindWithoutPath ,checkTimeParameters ,checkTimedCommand ,checkLocalScope @@ -116,7 +92,7 @@ commandChecks params = [ ,checkDeprecatedEgrep ,checkDeprecatedFgrep ,checkWhileGetoptsCase - ,checkCatastrophicRm (isPortageBuild params) + ,checkCatastrophicRm ,checkLetUsage ,checkMvArguments, checkCpArguments, checkLnArguments ,checkFindRedirections @@ -230,7 +206,7 @@ getChecker list = Checker { checker :: AnalysisSpec -> Parameters -> Checker -checker spec params = getChecker $ (commandChecks params) ++ optionals +checker spec params = getChecker $ commandChecks ++ optionals where keys = asOptionalChecks spec optionals = @@ -917,7 +893,6 @@ 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)) = @@ -1096,23 +1071,20 @@ checkWhileGetoptsCase = CommandCheck (Exactly "getopts") f T_Redirecting _ _ x@(T_CaseExpression {}) -> return x _ -> Nothing -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 -> - +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 -> when (isRecursive t) $ mapM_ (mapM_ checkWord . braceExpand) $ arguments t where @@ -1142,7 +1114,7 @@ checkCatastrophicRm isPortageBuild = CommandCheck (Basename "rm") $ \t -> f (T_DollarBraced _ _ word) = let var = onlyLiteralString word in -- This shouldn't handle non-colon cases. - if any (`isInfixOf` var) [":?", ":-", ":="] || (isPortageBuild && var `elem` ["D", "ED"]) + if any (`isInfixOf` var) [":?", ":-", ":="] then Nothing else return "" f _ = return "" @@ -1367,7 +1339,6 @@ checkMaskedReturns str = CommandCheck (Exactly str) checkCmd checkCmd t = do path <- getPathM t shell <- asks shellType - portageFileType <- asks portageFileType sequence_ $ do name <- getCommandName t @@ -1378,11 +1349,10 @@ 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 || isPortageBuild + guard . not $ isLocal && isReadOnly return $ mapM_ checkArgs $ arguments t diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 644c2f9..550ff87 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -1,8 +1,6 @@ module ShellCheck.Data where -import qualified Data.Map import ShellCheck.Interface -import ShellCheck.PortageVariables import Data.Version (showVersion) @@ -25,8 +23,8 @@ Use: import Paths_ShellCheck (version) shellcheckVersion = showVersion version -- VERSIONSTRING -genericInternalVariables :: [String] -genericInternalVariables = [ + +internalVariables = [ -- Generic "", "_", "rest", "REST", @@ -57,109 +55,15 @@ genericInternalVariables = [ "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 = [ "$", "?", "!", "#" ] @@ -177,30 +81,18 @@ 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" ] -shellArrayVariables = [ +arrayVariables = [ "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 bc258ed..e761e4d 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, csGentooData) + , CheckSpec(csFilename, csScript, csCheckSourced, csIncludedWarnings, csExcludedWarnings, csShellTypeOverride, csMinSeverity, csIgnoreRC, csOptionalChecks) , CheckResult(crFilename, crComments) , ParseSpec(psFilename, psScript, psCheckSourced, psIgnoreRC, psShellTypeOverride) , ParseResult(prComments, prTokenPositions, prRoot) - , AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asOptionalChecks, asPortageFileType, asGentooData) + , AnalysisSpec(..) , AnalysisResult(arComments) , FormatterOptions(foColorOption, foWikiLinkCount) , Shell(Ksh, Sh, Bash, Dash) @@ -59,12 +59,9 @@ 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 @@ -105,8 +102,7 @@ data CheckSpec = CheckSpec { csIncludedWarnings :: Maybe [Integer], csShellTypeOverride :: Maybe Shell, csMinSeverity :: Severity, - csOptionalChecks :: [String], - csGentooData :: EclassMap + csOptionalChecks :: [String] } deriving (Show, Eq) data CheckResult = CheckResult { @@ -130,8 +126,7 @@ emptyCheckSpec = CheckSpec { csIncludedWarnings = Nothing, csShellTypeOverride = Nothing, csMinSeverity = StyleC, - csOptionalChecks = [], - csGentooData = Map.empty + csOptionalChecks = [] } newParseSpec :: ParseSpec @@ -174,20 +169,6 @@ 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, @@ -195,10 +176,9 @@ data AnalysisSpec = AnalysisSpec { asFallbackShell :: Maybe Shell, asExecutionMode :: ExecutionMode, asCheckSourced :: Bool, + asIsPortage :: Bool, asOptionalChecks :: [String], - asTokenPositions :: Map.Map Id (Position, Position), - asPortageFileType :: PortageFileType, - asGentooData :: EclassMap + asTokenPositions :: Map.Map Id (Position, Position) } newAnalysisSpec token = AnalysisSpec { @@ -207,10 +187,9 @@ newAnalysisSpec token = AnalysisSpec { asFallbackShell = Nothing, asExecutionMode = Executed, asCheckSourced = False, + asIsPortage = False, asOptionalChecks = [], - asTokenPositions = Map.empty, - asPortageFileType = NonPortageRelated, - asGentooData = Map.empty + asTokenPositions = Map.empty } newtype AnalysisResult = AnalysisResult { diff --git a/src/ShellCheck/PortageVariables.hs b/src/ShellCheck/PortageVariables.hs index 3c6f611..54b8c1f 100644 --- a/src/ShellCheck/PortageVariables.hs +++ b/src/ShellCheck/PortageVariables.hs @@ -3,18 +3,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} -module ShellCheck.PortageVariables - ( RepoName - , RepoPath - , EclassName - , EclassVar - , EclassMap - , Repository(..) - , Eclass(..) - , portageVariables - , scanRepos - , decodeLenient - ) where +module ShellCheck.PortageVariables ( + readPortageVariables + ) where import Control.Applicative import Control.Exception (bracket) @@ -60,6 +51,9 @@ data Eclass = Eclass , eclassVars :: [EclassVar] } deriving (Show, Eq, Ord) +readPortageVariables :: IO (M.Map String [String]) +readPortageVariables = M.map (map decodeLenient) <$> portageVariables <$> scanRepos + -- | Map from eclass names to a list of eclass variables portageVariables :: [Repository] -> EclassMap portageVariables = foldMap $ foldMap go . repositoryEclasses @@ -70,7 +64,7 @@ portageVariables = foldMap $ foldMap go . repositoryEclasses -- one for eclasses and ultimately eclass metadata. scanRepos :: IO [Repository] scanRepos = do - let cmd = "/usr/bin/portageq" + let cmd = "portageq" let args = ["repos_config", "/"] out <- runOrDie cmd args case parseOnly reposParser out of