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:
hololeap 2023-08-05 15:16:30 -06:00
parent 08ae7ef836
commit 272ef819b9
No known key found for this signature in database
GPG key ID: 06B97EDD7A3D1E83
8 changed files with 58 additions and 18 deletions

View file

@ -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

View file

@ -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 $

View file

@ -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"

View file

@ -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 {

View file

@ -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 []

View file

@ -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 = [

View file

@ -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 {

View file

@ -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