mirror of
https://github.com/koalaman/shellcheck
synced 2025-07-10 23:32:57 -07:00
Scan for Gentoo eclass variables
Creates a Map of eclass names to eclass variables by scanning the system for repositories and their respective eclasses. Runs `portageq` to determine repository names and locations. Emits a warning if an IOException is caught when attempting to run `portageq`. This Map is passed via CheckSpec to AnalysisSpec and finally to Parameters, where it is read by `checkUnusedAssignments` in order to determine which variables can be safely ignored by this check. Signed-off-by: hololeap <hololeap@users.noreply.github.com>
This commit is contained in:
parent
08ae7ef836
commit
272ef819b9
8 changed files with 58 additions and 18 deletions
|
@ -93,11 +93,11 @@ library
|
||||||
ShellCheck.Formatter.Quiet
|
ShellCheck.Formatter.Quiet
|
||||||
ShellCheck.Interface
|
ShellCheck.Interface
|
||||||
ShellCheck.Parser
|
ShellCheck.Parser
|
||||||
|
ShellCheck.PortageVariables
|
||||||
ShellCheck.Prelude
|
ShellCheck.Prelude
|
||||||
ShellCheck.Regex
|
ShellCheck.Regex
|
||||||
other-modules:
|
other-modules:
|
||||||
Paths_ShellCheck
|
Paths_ShellCheck
|
||||||
ShellCheck.PortageVariables
|
|
||||||
ShellCheck.PortageAutoInternalVariables
|
ShellCheck.PortageAutoInternalVariables
|
||||||
default-language: Haskell98
|
default-language: Haskell98
|
||||||
|
|
||||||
|
|
|
@ -21,6 +21,7 @@ import qualified ShellCheck.Analyzer
|
||||||
import ShellCheck.Checker
|
import ShellCheck.Checker
|
||||||
import ShellCheck.Data
|
import ShellCheck.Data
|
||||||
import ShellCheck.Interface
|
import ShellCheck.Interface
|
||||||
|
import ShellCheck.PortageVariables
|
||||||
import ShellCheck.Regex
|
import ShellCheck.Regex
|
||||||
|
|
||||||
import qualified ShellCheck.Formatter.CheckStyle
|
import qualified ShellCheck.Formatter.CheckStyle
|
||||||
|
@ -240,10 +241,22 @@ runFormatter sys format options files = do
|
||||||
either (reportFailure filename) check input
|
either (reportFailure filename) check input
|
||||||
where
|
where
|
||||||
check contents = do
|
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) {
|
let checkspec = (checkSpec options) {
|
||||||
csFilename = filename,
|
csFilename = filename,
|
||||||
csScript = contents
|
csScript = contents,
|
||||||
|
csGentooData = gentooData
|
||||||
}
|
}
|
||||||
|
|
||||||
result <- checkScript sys checkspec
|
result <- checkScript sys checkspec
|
||||||
onResult format result sys
|
onResult format result sys
|
||||||
return $
|
return $
|
||||||
|
|
|
@ -2412,7 +2412,10 @@ allInternalVariables params =
|
||||||
genericInternalVariables ++
|
genericInternalVariables ++
|
||||||
if shellType params == Ksh then kshInternalVariables else [] ++
|
if shellType params == Ksh then kshInternalVariables else [] ++
|
||||||
if isPortageBuild params
|
if isPortageBuild params
|
||||||
then portageInternalVariables (getInheritedEclasses (rootNode params))
|
then
|
||||||
|
let eclasses = getInheritedEclasses $ rootNode params
|
||||||
|
gMap = gentooData params
|
||||||
|
in portageInternalVariables eclasses gMap
|
||||||
else []
|
else []
|
||||||
|
|
||||||
prop_checkUnused0 = verifyNotTree checkUnusedAssignments "var=foo; echo $var"
|
prop_checkUnused0 = verifyNotTree checkUnusedAssignments "var=foo; echo $var"
|
||||||
|
|
|
@ -27,6 +27,7 @@ import qualified ShellCheck.CFGAnalysis as CF
|
||||||
import ShellCheck.Data
|
import ShellCheck.Data
|
||||||
import ShellCheck.Interface
|
import ShellCheck.Interface
|
||||||
import ShellCheck.Parser
|
import ShellCheck.Parser
|
||||||
|
import ShellCheck.PortageVariables
|
||||||
import ShellCheck.Prelude
|
import ShellCheck.Prelude
|
||||||
import ShellCheck.Regex
|
import ShellCheck.Regex
|
||||||
|
|
||||||
|
@ -104,6 +105,8 @@ data Parameters = Parameters {
|
||||||
tokenPositions :: Map.Map Id (Position, Position),
|
tokenPositions :: Map.Map Id (Position, Position),
|
||||||
-- detailed type of any Portage related file
|
-- detailed type of any Portage related file
|
||||||
portageFileType :: PortageFileType,
|
portageFileType :: PortageFileType,
|
||||||
|
-- Gentoo-specific data
|
||||||
|
gentooData :: EclassMap,
|
||||||
-- Result from Control Flow Graph analysis (including data flow analysis)
|
-- Result from Control Flow Graph analysis (including data flow analysis)
|
||||||
cfgAnalysis :: CF.CFGAnalysis
|
cfgAnalysis :: CF.CFGAnalysis
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
@ -243,6 +246,7 @@ makeParameters spec = params
|
||||||
variableFlow = getVariableFlow params root,
|
variableFlow = getVariableFlow params root,
|
||||||
tokenPositions = asTokenPositions spec,
|
tokenPositions = asTokenPositions spec,
|
||||||
portageFileType = asPortageFileType spec,
|
portageFileType = asPortageFileType spec,
|
||||||
|
gentooData = asGentooData spec,
|
||||||
cfgAnalysis = CF.analyzeControlFlow cfParams root
|
cfgAnalysis = CF.analyzeControlFlow cfParams root
|
||||||
}
|
}
|
||||||
cfParams = CF.CFGParameters {
|
cfParams = CF.CFGParameters {
|
||||||
|
|
|
@ -89,7 +89,8 @@ checkScript sys spec = do
|
||||||
asExecutionMode = Executed,
|
asExecutionMode = Executed,
|
||||||
asTokenPositions = tokenPositions,
|
asTokenPositions = tokenPositions,
|
||||||
asOptionalChecks = getEnableDirectives root ++ csOptionalChecks spec,
|
asOptionalChecks = getEnableDirectives root ++ csOptionalChecks spec,
|
||||||
asPortageFileType = getPortageFileType $ csFilename spec
|
asPortageFileType = getPortageFileType $ csFilename spec,
|
||||||
|
asGentooData = csGentooData spec
|
||||||
} where as = newAnalysisSpec root
|
} where as = newAnalysisSpec root
|
||||||
let analysisMessages =
|
let analysisMessages =
|
||||||
maybe []
|
maybe []
|
||||||
|
|
|
@ -2,6 +2,7 @@ module ShellCheck.Data where
|
||||||
|
|
||||||
import qualified Data.Map
|
import qualified Data.Map
|
||||||
import ShellCheck.Interface
|
import ShellCheck.Interface
|
||||||
|
import ShellCheck.PortageVariables
|
||||||
import ShellCheck.PortageAutoInternalVariables
|
import ShellCheck.PortageAutoInternalVariables
|
||||||
import Data.Version (showVersion)
|
import Data.Version (showVersion)
|
||||||
|
|
||||||
|
@ -149,14 +150,15 @@ portageManualInternalVariables = [
|
||||||
"LINGUAS"
|
"LINGUAS"
|
||||||
]
|
]
|
||||||
|
|
||||||
eclassVarsFromMap :: String -> [String]
|
eclassVarsFromMap :: EclassMap -> String -> [String]
|
||||||
eclassVarsFromMap eclass =
|
eclassVarsFromMap gMap eclass =
|
||||||
Data.Map.findWithDefault []
|
Data.Map.findWithDefault []
|
||||||
eclass
|
eclass
|
||||||
portageAutoInternalVariables
|
gMap
|
||||||
|
|
||||||
portageInternalVariables inheritedEclasses =
|
portageInternalVariables :: [String] -> EclassMap -> [String]
|
||||||
portageManualInternalVariables ++ concatMap eclassVarsFromMap
|
portageInternalVariables inheritedEclasses gMap =
|
||||||
|
portageManualInternalVariables ++ concatMap (eclassVarsFromMap gMap)
|
||||||
inheritedEclasses
|
inheritedEclasses
|
||||||
|
|
||||||
specialIntegerVariables = [
|
specialIntegerVariables = [
|
||||||
|
|
|
@ -21,11 +21,11 @@
|
||||||
module ShellCheck.Interface
|
module ShellCheck.Interface
|
||||||
(
|
(
|
||||||
SystemInterface(..)
|
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)
|
, CheckResult(crFilename, crComments)
|
||||||
, ParseSpec(psFilename, psScript, psCheckSourced, psIgnoreRC, psShellTypeOverride)
|
, ParseSpec(psFilename, psScript, psCheckSourced, psIgnoreRC, psShellTypeOverride)
|
||||||
, ParseResult(prComments, prTokenPositions, prRoot)
|
, ParseResult(prComments, prTokenPositions, prRoot)
|
||||||
, AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asOptionalChecks, asPortageFileType)
|
, AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asOptionalChecks, asPortageFileType, asGentooData)
|
||||||
, AnalysisResult(arComments)
|
, AnalysisResult(arComments)
|
||||||
, FormatterOptions(foColorOption, foWikiLinkCount)
|
, FormatterOptions(foColorOption, foWikiLinkCount)
|
||||||
, Shell(Ksh, Sh, Bash, Dash)
|
, Shell(Ksh, Sh, Bash, Dash)
|
||||||
|
@ -63,6 +63,7 @@ module ShellCheck.Interface
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import ShellCheck.AST
|
import ShellCheck.AST
|
||||||
|
import ShellCheck.PortageVariables (EclassMap)
|
||||||
|
|
||||||
import Control.DeepSeq
|
import Control.DeepSeq
|
||||||
import Control.Monad.Identity
|
import Control.Monad.Identity
|
||||||
|
@ -101,7 +102,8 @@ data CheckSpec = CheckSpec {
|
||||||
csIncludedWarnings :: Maybe [Integer],
|
csIncludedWarnings :: Maybe [Integer],
|
||||||
csShellTypeOverride :: Maybe Shell,
|
csShellTypeOverride :: Maybe Shell,
|
||||||
csMinSeverity :: Severity,
|
csMinSeverity :: Severity,
|
||||||
csOptionalChecks :: [String]
|
csOptionalChecks :: [String],
|
||||||
|
csGentooData :: EclassMap
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
data CheckResult = CheckResult {
|
data CheckResult = CheckResult {
|
||||||
|
@ -125,7 +127,8 @@ emptyCheckSpec = CheckSpec {
|
||||||
csIncludedWarnings = Nothing,
|
csIncludedWarnings = Nothing,
|
||||||
csShellTypeOverride = Nothing,
|
csShellTypeOverride = Nothing,
|
||||||
csMinSeverity = StyleC,
|
csMinSeverity = StyleC,
|
||||||
csOptionalChecks = []
|
csOptionalChecks = [],
|
||||||
|
csGentooData = Map.empty
|
||||||
}
|
}
|
||||||
|
|
||||||
newParseSpec :: ParseSpec
|
newParseSpec :: ParseSpec
|
||||||
|
@ -182,7 +185,8 @@ data AnalysisSpec = AnalysisSpec {
|
||||||
asCheckSourced :: Bool,
|
asCheckSourced :: Bool,
|
||||||
asOptionalChecks :: [String],
|
asOptionalChecks :: [String],
|
||||||
asTokenPositions :: Map.Map Id (Position, Position),
|
asTokenPositions :: Map.Map Id (Position, Position),
|
||||||
asPortageFileType :: PortageFileType
|
asPortageFileType :: PortageFileType,
|
||||||
|
asGentooData :: EclassMap
|
||||||
}
|
}
|
||||||
|
|
||||||
newAnalysisSpec token = AnalysisSpec {
|
newAnalysisSpec token = AnalysisSpec {
|
||||||
|
@ -193,7 +197,8 @@ newAnalysisSpec token = AnalysisSpec {
|
||||||
asCheckSourced = False,
|
asCheckSourced = False,
|
||||||
asOptionalChecks = [],
|
asOptionalChecks = [],
|
||||||
asTokenPositions = Map.empty,
|
asTokenPositions = Map.empty,
|
||||||
asPortageFileType = NonPortageRelated
|
asPortageFileType = NonPortageRelated,
|
||||||
|
asGentooData = Map.empty
|
||||||
}
|
}
|
||||||
|
|
||||||
newtype AnalysisResult = AnalysisResult {
|
newtype AnalysisResult = AnalysisResult {
|
||||||
|
|
|
@ -2,7 +2,9 @@
|
||||||
module ShellCheck.PortageVariables
|
module ShellCheck.PortageVariables
|
||||||
( RepoName
|
( RepoName
|
||||||
, RepoPath
|
, RepoPath
|
||||||
|
, EclassName
|
||||||
, EclassVar
|
, EclassVar
|
||||||
|
, EclassMap
|
||||||
, Repository(..)
|
, Repository(..)
|
||||||
, Eclass(..)
|
, Eclass(..)
|
||||||
, portageVariables
|
, portageVariables
|
||||||
|
@ -18,14 +20,19 @@ import qualified Data.Map as M
|
||||||
import System.Directory (listDirectory)
|
import System.Directory (listDirectory)
|
||||||
import System.Exit (ExitCode(..))
|
import System.Exit (ExitCode(..))
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.Process -- (readProcessWithExitCode)
|
import System.Process
|
||||||
import Text.Parsec hiding ((<|>))
|
import Text.Parsec hiding ((<|>))
|
||||||
import Text.Parsec.String
|
import Text.Parsec.String
|
||||||
|
|
||||||
type RepoName = String
|
type RepoName = String
|
||||||
type RepoPath = FilePath
|
type RepoPath = FilePath
|
||||||
|
type EclassName = String
|
||||||
type EclassVar = String
|
type EclassVar = String
|
||||||
|
|
||||||
|
-- | 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
|
data Repository = Repository
|
||||||
{ repositoryName :: RepoName
|
{ repositoryName :: RepoName
|
||||||
, repositoryLocation :: RepoPath
|
, repositoryLocation :: RepoPath
|
||||||
|
@ -33,11 +40,12 @@ data Repository = Repository
|
||||||
} deriving (Show, Eq, Ord)
|
} deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
data Eclass = Eclass
|
data Eclass = Eclass
|
||||||
{ eclassName :: String
|
{ eclassName :: EclassName
|
||||||
, eclassVars :: [EclassVar]
|
, eclassVars :: [EclassVar]
|
||||||
} deriving (Show, Eq, Ord)
|
} deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
portageVariables :: [Repository] -> Map String [EclassVar]
|
-- | Map from eclass names to a list of eclass variables
|
||||||
|
portageVariables :: [Repository] -> EclassMap
|
||||||
portageVariables = foldMap $ foldMap go . repositoryEclasses
|
portageVariables = foldMap $ foldMap go . repositoryEclasses
|
||||||
where
|
where
|
||||||
go e = M.singleton (eclassName e) (eclassVars e)
|
go e = M.singleton (eclassName e) (eclassVars e)
|
||||||
|
@ -91,9 +99,11 @@ reposParser =
|
||||||
endOfBlock :: Parser ()
|
endOfBlock :: Parser ()
|
||||||
endOfBlock = void endOfLine <|> eof
|
endOfBlock = void endOfLine <|> eof
|
||||||
|
|
||||||
|
-- cons the repo and continue parsing
|
||||||
insert :: (RepoName, RepoPath) -> Parser [(RepoName, RepoPath)]
|
insert :: (RepoName, RepoPath) -> Parser [(RepoName, RepoPath)]
|
||||||
insert r = (r:) <$> reposParser
|
insert r = (r:) <$> reposParser
|
||||||
|
|
||||||
|
-- skip the repo and continue parsing
|
||||||
ignore :: Parser [(RepoName, RepoPath)]
|
ignore :: Parser [(RepoName, RepoPath)]
|
||||||
ignore = reposParser
|
ignore = reposParser
|
||||||
|
|
||||||
|
@ -116,6 +126,8 @@ getEclasses repoLoc = fmap (maybe [] id) $ runMaybeT $ do
|
||||||
Left pe -> lift $ fail $ show pe
|
Left pe -> lift $ fail $ show pe
|
||||||
Right vs -> pure $ Eclass n vs
|
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 :: Parser [EclassVar]
|
||||||
eclassParser = choice
|
eclassParser = choice
|
||||||
[ -- cons the EclassVar to the list and continue
|
[ -- cons the EclassVar to the list and continue
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue