| {- |
| Copyright 2012-2015 Vidar Holen |
| |
| This file is part of ShellCheck. |
| https://www.shellcheck.net |
| |
| ShellCheck is free software: you can redistribute it and/or modify |
| it under the terms of the GNU General Public License as published by |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| |
| ShellCheck is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU General Public License for more details. |
| |
| You should have received a copy of the GNU General Public License |
| along with this program. If not, see <https://www.gnu.org/licenses/>. |
| -} |
| {-# LANGUAGE FlexibleContexts #-} |
| {-# LANGUAGE TemplateHaskell #-} |
| module ShellCheck.AnalyzerLib where |
| import ShellCheck.AST |
| import ShellCheck.ASTLib |
| import ShellCheck.Data |
| import ShellCheck.Interface |
| import ShellCheck.Parser |
| import ShellCheck.Regex |
| |
| import Control.Arrow (first) |
| import Control.Monad.Identity |
| import Control.Monad.RWS |
| import Control.Monad.State |
| import Control.Monad.Writer |
| import Data.Char |
| import Data.List |
| import qualified Data.Map as Map |
| import Data.Maybe |
| import Data.Semigroup |
| |
| import Test.QuickCheck.All (forAllProperties) |
| import Test.QuickCheck.Test (maxSuccess, quickCheckWithResult, stdArgs) |
| |
| type Analysis = AnalyzerM () |
| type AnalyzerM a = RWS Parameters [TokenComment] Cache a |
| nullCheck = const $ return () |
| |
| |
| data Checker = Checker { |
| perScript :: Root -> Analysis, |
| perToken :: Token -> Analysis |
| } |
| |
| runChecker :: Parameters -> Checker -> [TokenComment] |
| runChecker params checker = notes |
| where |
| root = rootNode params |
| check = perScript checker `composeAnalyzers` (\(Root x) -> void $ doAnalysis (perToken checker) x) |
| notes = snd $ evalRWS (check $ Root root) params Cache |
| |
| instance Semigroup Checker where |
| (<>) x y = Checker { |
| perScript = perScript x `composeAnalyzers` perScript y, |
| perToken = perToken x `composeAnalyzers` perToken y |
| } |
| |
| instance Monoid Checker where |
| mempty = Checker { |
| perScript = nullCheck, |
| perToken = nullCheck |
| } |
| mappend = (Data.Semigroup.<>) |
| |
| composeAnalyzers :: (a -> Analysis) -> (a -> Analysis) -> a -> Analysis |
| composeAnalyzers f g x = f x >> g x |
| |
| data Parameters = Parameters { |
| hasLastpipe :: Bool, -- Whether this script has the 'lastpipe' option set/default. |
| hasSetE :: Bool, -- Whether this script has 'set -e' anywhere. |
| variableFlow :: [StackData], -- A linear (bad) analysis of data flow |
| parentMap :: Map.Map Id Token, -- A map from Id to parent Token |
| shellType :: Shell, -- The shell type, such as Bash or Ksh |
| shellTypeSpecified :: Bool, -- True if shell type was forced via flags |
| rootNode :: Token -- The root node of the AST |
| } |
| |
| -- TODO: Cache results of common AST ops here |
| data Cache = Cache {} |
| |
| data Scope = SubshellScope String | NoneScope deriving (Show, Eq) |
| data StackData = |
| StackScope Scope |
| | StackScopeEnd |
| -- (Base expression, specific position, var name, assigned values) |
| | Assignment (Token, Token, String, DataType) |
| | Reference (Token, Token, String) |
| deriving (Show) |
| |
| data DataType = DataString DataSource | DataArray DataSource |
| deriving (Show) |
| |
| data DataSource = |
| SourceFrom [Token] |
| | SourceExternal |
| | SourceDeclaration |
| | SourceInteger |
| | SourceChecked |
| deriving (Show) |
| |
| data VariableState = Dead Token String | Alive deriving (Show) |
| |
| defaultSpec root = spec { |
| asShellType = Nothing, |
| asCheckSourced = False, |
| asExecutionMode = Executed |
| } where spec = newAnalysisSpec root |
| |
| pScript s = |
| let |
| pSpec = newParseSpec { |
| psFilename = "script", |
| psScript = s |
| } |
| in prRoot . runIdentity $ parseScript (mockedSystemInterface []) pSpec |
| |
| -- For testing. If parsed, returns whether there are any comments |
| producesComments :: Checker -> String -> Maybe Bool |
| producesComments c s = do |
| root <- pScript s |
| let spec = defaultSpec root |
| let params = makeParameters spec |
| return . not . null $ runChecker params c |
| |
| makeComment :: Severity -> Id -> Code -> String -> TokenComment |
| makeComment severity id code note = |
| newTokenComment { |
| tcId = id, |
| tcComment = newComment { |
| cSeverity = severity, |
| cCode = code, |
| cMessage = note |
| } |
| } |
| |
| addComment note = tell [note] |
| |
| warn :: MonadWriter [TokenComment] m => Id -> Code -> String -> m () |
| warn id code str = addComment $ makeComment WarningC id code str |
| err id code str = addComment $ makeComment ErrorC id code str |
| info id code str = addComment $ makeComment InfoC id code str |
| style id code str = addComment $ makeComment StyleC id code str |
| |
| makeParameters spec = |
| let params = Parameters { |
| rootNode = root, |
| shellType = fromMaybe (determineShell root) $ asShellType spec, |
| hasSetE = containsSetE root, |
| hasLastpipe = |
| case shellType params of |
| Bash -> containsLastpipe root |
| Dash -> False |
| Sh -> False |
| Ksh -> True, |
| |
| shellTypeSpecified = isJust $ asShellType spec, |
| parentMap = getParentTree root, |
| variableFlow = getVariableFlow params root |
| } in params |
| where root = asScript spec |
| |
| |
| -- Does this script mention 'set -e' anywhere? |
| -- Used as a hack to disable certain warnings. |
| containsSetE root = isNothing $ doAnalysis (guard . not . isSetE) root |
| where |
| isSetE t = |
| case t of |
| T_Script _ str _ -> str `matches` re |
| T_SimpleCommand {} -> |
| t `isUnqualifiedCommand` "set" && |
| ("errexit" `elem` oversimplify t || |
| "e" `elem` map snd (getAllFlags t)) |
| _ -> False |
| re = mkRegex "[[:space:]]-[^-]*e" |
| |
| -- Does this script mention 'shopt -s lastpipe' anywhere? |
| -- Also used as a hack. |
| containsLastpipe root = |
| isNothing $ doAnalysis (guard . not . isShoptLastPipe) root |
| where |
| isShoptLastPipe t = |
| case t of |
| T_SimpleCommand {} -> |
| t `isUnqualifiedCommand` "shopt" && |
| ("lastpipe" `elem` oversimplify t) |
| _ -> False |
| |
| |
| prop_determineShell0 = determineShell (fromJust $ pScript "#!/bin/sh") == Sh |
| prop_determineShell1 = determineShell (fromJust $ pScript "#!/usr/bin/env ksh") == Ksh |
| prop_determineShell2 = determineShell (fromJust $ pScript "") == Bash |
| prop_determineShell3 = determineShell (fromJust $ pScript "#!/bin/sh -e") == Sh |
| prop_determineShell4 = determineShell (fromJust $ pScript |
| "#!/bin/ksh\n#shellcheck shell=sh\nfoo") == Sh |
| prop_determineShell5 = determineShell (fromJust $ pScript |
| "#shellcheck shell=sh\nfoo") == Sh |
| prop_determineShell6 = determineShell (fromJust $ pScript "#! /bin/sh") == Sh |
| prop_determineShell7 = determineShell (fromJust $ pScript "#! /bin/ash") == Dash |
| determineShell t = fromMaybe Bash $ do |
| shellString <- foldl mplus Nothing $ getCandidates t |
| shellForExecutable shellString |
| where |
| forAnnotation t = |
| case t of |
| (ShellOverride s) -> return s |
| _ -> fail "" |
| getCandidates :: Token -> [Maybe String] |
| getCandidates t@T_Script {} = [Just $ fromShebang t] |
| getCandidates (T_Annotation _ annotations s) = |
| map forAnnotation annotations ++ |
| [Just $ fromShebang s] |
| fromShebang (T_Script _ s t) = executableFromShebang s |
| |
| -- Given a string like "/bin/bash" or "/usr/bin/env dash", |
| -- return the shell basename like "bash" or "dash" |
| executableFromShebang :: String -> String |
| executableFromShebang = shellFor |
| where |
| shellFor s | "/env " `isInfixOf` s = head (drop 1 (words s)++[""]) |
| shellFor s | ' ' `elem` s = shellFor $ takeWhile (/= ' ') s |
| shellFor s = reverse . takeWhile (/= '/') . reverse $ s |
| |
| |
| |
| -- Given a root node, make a map from Id to parent Token. |
| -- This is used to populate parentMap in Parameters |
| getParentTree :: Token -> Map.Map Id Token |
| getParentTree t = |
| snd . snd $ runState (doStackAnalysis pre post t) ([], Map.empty) |
| where |
| pre t = modify (first ((:) t)) |
| post t = do |
| (x, map) <- get |
| case x of |
| _:rest -> case rest of [] -> put (rest, map) |
| (x:_) -> put (rest, Map.insert (getId t) x map) |
| |
| -- Given a root node, make a map from Id to Token |
| getTokenMap :: Token -> Map.Map Id Token |
| getTokenMap t = |
| execState (doAnalysis f t) Map.empty |
| where |
| f t = modify (Map.insert (getId t) t) |
| |
| |
| -- Is this token in a quoting free context? (i.e. would variable expansion split) |
| -- True: Assignments, [[ .. ]], here docs, already in double quotes |
| -- False: Regular words |
| isStrictlyQuoteFree = isQuoteFreeNode True |
| |
| -- Like above, but also allow some cases where splitting may be desired. |
| -- True: Like above + for loops |
| -- False: Like above |
| isQuoteFree = isQuoteFreeNode False |
| |
| |
| isQuoteFreeNode strict tree t = |
| (isQuoteFreeElement t == Just True) || |
| head (mapMaybe isQuoteFreeContext (drop 1 $ getPath tree t) ++ [False]) |
| where |
| -- Is this node self-quoting in itself? |
| isQuoteFreeElement t = |
| case t of |
| T_Assignment {} -> return True |
| T_FdRedirect {} -> return True |
| _ -> Nothing |
| |
| -- Are any subnodes inherently self-quoting? |
| isQuoteFreeContext t = |
| case t of |
| TC_Nullary _ DoubleBracket _ -> return True |
| TC_Unary _ DoubleBracket _ _ -> return True |
| TC_Binary _ DoubleBracket _ _ _ -> return True |
| TA_Sequence {} -> return True |
| T_Arithmetic {} -> return True |
| T_Assignment {} -> return True |
| T_Redirecting {} -> return False |
| T_DoubleQuoted _ _ -> return True |
| T_DollarDoubleQuoted _ _ -> return True |
| T_CaseExpression {} -> return True |
| T_HereDoc {} -> return True |
| T_DollarBraced {} -> return True |
| -- When non-strict, pragmatically assume it's desirable to split here |
| T_ForIn {} -> return (not strict) |
| T_SelectIn {} -> return (not strict) |
| _ -> Nothing |
| |
| -- Check if a token is a parameter to a certain command by name: |
| -- Example: isParamTo (parentMap params) "sed" t |
| isParamTo :: Map.Map Id Token -> String -> Token -> Bool |
| isParamTo tree cmd = |
| go |
| where |
| go x = case Map.lookup (getId x) tree of |
| Nothing -> False |
| Just parent -> check parent |
| check t = |
| case t of |
| T_SingleQuoted _ _ -> go t |
| T_DoubleQuoted _ _ -> go t |
| T_NormalWord _ _ -> go t |
| T_SimpleCommand {} -> isCommand t cmd |
| T_Redirecting {} -> isCommand t cmd |
| _ -> False |
| |
| -- Get the parent command (T_Redirecting) of a Token, if any. |
| getClosestCommand :: Map.Map Id Token -> Token -> Maybe Token |
| getClosestCommand tree t = |
| findFirst findCommand $ getPath tree t |
| where |
| findCommand t = |
| case t of |
| T_Redirecting {} -> return True |
| T_Script {} -> return False |
| _ -> Nothing |
| |
| -- Like above, if koala_man knew Haskell when starting this project. |
| getClosestCommandM t = do |
| tree <- asks parentMap |
| return $ getClosestCommand tree t |
| |
| -- Is the token used as a command name (the first word in a T_SimpleCommand)? |
| usedAsCommandName tree token = go (getId token) (tail $ getPath tree token) |
| where |
| go currentId (T_NormalWord id [word]:rest) |
| | currentId == getId word = go id rest |
| go currentId (T_DoubleQuoted id [word]:rest) |
| | currentId == getId word = go id rest |
| go currentId (T_SimpleCommand _ _ (word:_):_) |
| | currentId == getId word = True |
| go _ _ = False |
| |
| -- A list of the element and all its parents up to the root node. |
| getPath tree t = t : |
| case Map.lookup (getId t) tree of |
| Nothing -> [] |
| Just parent -> getPath tree parent |
| |
| -- Version of the above taking the map from the current context |
| -- Todo: give this the name "getPath" |
| getPathM t = do |
| map <- asks parentMap |
| return $ getPath map t |
| |
| isParentOf tree parent child = |
| elem (getId parent) . map getId $ getPath tree child |
| |
| parents params = getPath (parentMap params) |
| |
| pathTo t = do |
| parents <- reader parentMap |
| return $ getPath parents t |
| |
| -- Find the first match in a list where the predicate is Just True. |
| -- Stops if it's Just False and ignores Nothing. |
| findFirst :: (a -> Maybe Bool) -> [a] -> Maybe a |
| findFirst p l = |
| case l of |
| [] -> Nothing |
| (x:xs) -> |
| case p x of |
| Just True -> return x |
| Just False -> Nothing |
| Nothing -> findFirst p xs |
| |
| -- Check whether a word is entirely output from a single command |
| tokenIsJustCommandOutput t = case t of |
| T_NormalWord id [T_DollarExpansion _ cmds] -> check cmds |
| T_NormalWord id [T_DoubleQuoted _ [T_DollarExpansion _ cmds]] -> check cmds |
| T_NormalWord id [T_Backticked _ cmds] -> check cmds |
| T_NormalWord id [T_DoubleQuoted _ [T_Backticked _ cmds]] -> check cmds |
| _ -> False |
| where |
| check [x] = not $ isOnlyRedirection x |
| check _ = False |
| |
| -- TODO: Replace this with a proper Control Flow Graph |
| getVariableFlow params t = |
| let (_, stack) = runState (doStackAnalysis startScope endScope t) [] |
| in reverse stack |
| where |
| startScope t = |
| let scopeType = leadType params t |
| in do |
| when (scopeType /= NoneScope) $ modify (StackScope scopeType:) |
| when (assignFirst t) $ setWritten t |
| |
| endScope t = |
| let scopeType = leadType params t |
| in do |
| setRead t |
| unless (assignFirst t) $ setWritten t |
| when (scopeType /= NoneScope) $ modify (StackScopeEnd:) |
| |
| assignFirst T_ForIn {} = True |
| assignFirst T_SelectIn {} = True |
| assignFirst _ = False |
| |
| setRead t = |
| let read = getReferencedVariables (parentMap params) t |
| in mapM_ (\v -> modify (Reference v:)) read |
| |
| setWritten t = |
| let written = getModifiedVariables t |
| in mapM_ (\v -> modify (Assignment v:)) written |
| |
| |
| leadType params t = |
| case t of |
| T_DollarExpansion _ _ -> SubshellScope "$(..) expansion" |
| T_Backticked _ _ -> SubshellScope "`..` expansion" |
| T_Backgrounded _ _ -> SubshellScope "backgrounding &" |
| T_Subshell _ _ -> SubshellScope "(..) group" |
| T_CoProcBody _ _ -> SubshellScope "coproc" |
| T_Redirecting {} -> |
| if fromMaybe False causesSubshell |
| then SubshellScope "pipeline" |
| else NoneScope |
| _ -> NoneScope |
| where |
| parentPipeline = do |
| parent <- Map.lookup (getId t) (parentMap params) |
| case parent of |
| T_Pipeline {} -> return parent |
| _ -> Nothing |
| |
| causesSubshell = do |
| (T_Pipeline _ _ list) <- parentPipeline |
| if length list <= 1 |
| then return False |
| else if not $ hasLastpipe params |
| then return True |
| else return . not $ (getId . head $ reverse list) == getId t |
| |
| getModifiedVariables t = |
| case t of |
| T_SimpleCommand _ vars [] -> |
| concatMap (\x -> case x of |
| T_Assignment id _ name _ w -> |
| [(x, x, name, dataTypeFrom DataString w)] |
| _ -> [] |
| ) vars |
| c@T_SimpleCommand {} -> |
| getModifiedVariableCommand c |
| |
| TA_Unary _ "++|" v@(TA_Variable _ name _) -> |
| [(t, v, name, DataString $ SourceFrom [v])] |
| TA_Unary _ "|++" v@(TA_Variable _ name _) -> |
| [(t, v, name, DataString $ SourceFrom [v])] |
| TA_Assignment _ op (TA_Variable _ name _) rhs -> maybeToList $ do |
| guard $ op `elem` ["=", "*=", "/=", "%=", "+=", "-=", "<<=", ">>=", "&=", "^=", "|="] |
| return (t, t, name, DataString $ SourceFrom [rhs]) |
| |
| -- Count [[ -v foo ]] as an "assignment". |
| -- This is to prevent [ -v foo ] being unassigned or unused. |
| TC_Unary id _ "-v" token -> maybeToList $ do |
| str <- fmap (takeWhile (/= '[')) $ -- Quoted index |
| flip getLiteralStringExt token $ \x -> |
| case x of |
| T_Glob _ s -> return s -- Unquoted index |
| _ -> Nothing |
| |
| guard . not . null $ str |
| return (t, token, str, DataString SourceChecked) |
| |
| T_DollarBraced _ l -> maybeToList $ do |
| let string = bracedString t |
| let modifier = getBracedModifier string |
| guard $ ":=" `isPrefixOf` modifier |
| return (t, t, getBracedReference string, DataString $ SourceFrom [l]) |
| |
| t@(T_FdRedirect _ ('{':var) op) -> -- {foo}>&2 modifies foo |
| [(t, t, takeWhile (/= '}') var, DataString SourceInteger) | not $ isClosingFileOp op] |
| |
| t@(T_CoProc _ name _) -> |
| [(t, t, fromMaybe "COPROC" name, DataArray SourceInteger)] |
| |
| --Points to 'for' rather than variable |
| T_ForIn id str [] _ -> [(t, t, str, DataString SourceExternal)] |
| T_ForIn id str words _ -> [(t, t, str, DataString $ SourceFrom words)] |
| T_SelectIn id str words _ -> [(t, t, str, DataString $ SourceFrom words)] |
| _ -> [] |
| |
| isClosingFileOp op = |
| case op of |
| T_IoDuplicate _ (T_GREATAND _) "-" -> True |
| T_IoDuplicate _ (T_LESSAND _) "-" -> True |
| _ -> False |
| |
| |
| -- Consider 'export/declare -x' a reference, since it makes the var available |
| getReferencedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Literal _ x:_):rest)) = |
| case x of |
| "export" -> if "f" `elem` flags |
| then [] |
| else concatMap getReference rest |
| "declare" -> if |
| any (`elem` flags) ["x", "p"] && |
| (not $ any (`elem` flags) ["f", "F"]) |
| then concatMap getReference rest |
| else [] |
| "readonly" -> |
| if any (`elem` flags) ["f", "p"] |
| then [] |
| else concatMap getReference rest |
| "trap" -> |
| case rest of |
| head:_ -> map (\x -> (head, head, x)) $ getVariablesFromLiteralToken head |
| _ -> [] |
| _ -> [] |
| where |
| getReference t@(T_Assignment _ _ name _ value) = [(t, t, name)] |
| getReference t@(T_NormalWord _ [T_Literal _ name]) | not ("-" `isPrefixOf` name) = [(t, t, name)] |
| getReference _ = [] |
| flags = map snd $ getAllFlags base |
| |
| getReferencedVariableCommand _ = [] |
| |
| -- The function returns a tuple consisting of four items describing an assignment. |
| -- Given e.g. declare foo=bar |
| -- ( |
| -- BaseCommand :: Token, -- The command/structure assigning the variable, i.e. declare foo=bar |
| -- AssignmentToken :: Token, -- The specific part that assigns this variable, i.e. foo=bar |
| -- VariableName :: String, -- The variable name, i.e. foo |
| -- VariableValue :: DataType -- A description of the value being assigned, i.e. "Literal string with value foo" |
| -- ) |
| getModifiedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Literal _ x:_):rest)) = |
| filter (\(_,_,s,_) -> not ("-" `isPrefixOf` s)) $ |
| case x of |
| "read" -> |
| let params = map getLiteral rest |
| readArrayVars = getReadArrayVariables rest |
| in |
| catMaybes . (++ readArrayVars) . takeWhile isJust . reverse $ params |
| "getopts" -> |
| case rest of |
| opts:var:_ -> maybeToList $ getLiteral var |
| _ -> [] |
| |
| "let" -> concatMap letParamToLiteral rest |
| |
| "export" -> |
| if "f" `elem` flags then [] else concatMap getModifierParamString rest |
| |
| "declare" -> if any (`elem` flags) ["F", "f", "p"] then [] else declaredVars |
| "typeset" -> declaredVars |
| |
| "local" -> concatMap getModifierParamString rest |
| "readonly" -> |
| if any (`elem` flags) ["f", "p"] |
| then [] |
| else concatMap getModifierParamString rest |
| "set" -> maybeToList $ do |
| params <- getSetParams rest |
| return (base, base, "@", DataString $ SourceFrom params) |
| |
| "printf" -> maybeToList $ getPrintfVariable rest |
| |
| "mapfile" -> maybeToList $ getMapfileArray base rest |
| "readarray" -> maybeToList $ getMapfileArray base rest |
| |
| _ -> [] |
| where |
| flags = map snd $ getAllFlags base |
| stripEquals s = let rest = dropWhile (/= '=') s in |
| if rest == "" then "" else tail rest |
| stripEqualsFrom (T_NormalWord id1 (T_Literal id2 s:rs)) = |
| T_NormalWord id1 (T_Literal id2 (stripEquals s):rs) |
| stripEqualsFrom (T_NormalWord id1 [T_DoubleQuoted id2 [T_Literal id3 s]]) = |
| T_NormalWord id1 [T_DoubleQuoted id2 [T_Literal id3 (stripEquals s)]] |
| stripEqualsFrom t = t |
| |
| declaredVars = concatMap (getModifierParam defaultType) rest |
| where |
| defaultType = if any (`elem` flags) ["a", "A"] then DataArray else DataString |
| |
| getLiteralOfDataType t d = do |
| s <- getLiteralString t |
| when ("-" `isPrefixOf` s) $ fail "argument" |
| return (base, t, s, d) |
| |
| getLiteral t = getLiteralOfDataType t (DataString SourceExternal) |
| |
| getLiteralArray t = getLiteralOfDataType t (DataArray SourceExternal) |
| |
| getModifierParamString = getModifierParam DataString |
| |
| getModifierParam def t@(T_Assignment _ _ name _ value) = |
| [(base, t, name, dataTypeFrom def value)] |
| getModifierParam def t@T_NormalWord {} = maybeToList $ do |
| name <- getLiteralString t |
| guard $ isVariableName name |
| return (base, t, name, def SourceDeclaration) |
| getModifierParam _ _ = [] |
| |
| letParamToLiteral token = |
| if var == "" |
| then [] |
| else [(base, token, var, DataString $ SourceFrom [stripEqualsFrom token])] |
| where var = takeWhile isVariableChar $ dropWhile (`elem` "+-") $ concat $ oversimplify token |
| |
| getSetParams (t:_:rest) | getLiteralString t == Just "-o" = getSetParams rest |
| getSetParams (t:rest) = |
| let s = getLiteralString t in |
| case s of |
| Just "--" -> return rest |
| Just ('-':_) -> getSetParams rest |
| _ -> return (t:fromMaybe [] (getSetParams rest)) |
| getSetParams [] = Nothing |
| |
| getPrintfVariable list = f $ map (\x -> (x, getLiteralString x)) list |
| where |
| f ((_, Just "-v") : (t, Just var) : _) = return (base, t, var, DataString $ SourceFrom list) |
| f (_:rest) = f rest |
| f [] = fail "not found" |
| |
| -- mapfile has some curious syntax allowing flags plus 0..n variable names |
| -- where only the first non-option one is used if any. Here we cheat and |
| -- just get the last one, if it's a variable name. |
| getMapfileArray base arguments = do |
| lastArg <- listToMaybe (reverse arguments) |
| name <- getLiteralString lastArg |
| guard $ isVariableName name |
| return (base, lastArg, name, DataArray SourceExternal) |
| |
| -- get all the array variables used in read, e.g. read -a arr |
| getReadArrayVariables args = do |
| map (getLiteralArray . snd) |
| (filter (\(x,_) -> getLiteralString x == Just "-a") (zip (args) (tail args))) |
| |
| getModifiedVariableCommand _ = [] |
| |
| getIndexReferences s = fromMaybe [] $ do |
| match <- matchRegex re s |
| index <- match !!! 0 |
| return $ matchAllStrings variableNameRegex index |
| where |
| re = mkRegex "(\\[.*\\])" |
| |
| prop_getOffsetReferences1 = getOffsetReferences ":bar" == ["bar"] |
| prop_getOffsetReferences2 = getOffsetReferences ":bar:baz" == ["bar", "baz"] |
| prop_getOffsetReferences3 = getOffsetReferences "[foo]:bar" == ["bar"] |
| prop_getOffsetReferences4 = getOffsetReferences "[foo]:bar:baz" == ["bar", "baz"] |
| getOffsetReferences mods = fromMaybe [] $ do |
| -- if mods start with [, then drop until ] |
| match <- matchRegex re mods |
| offsets <- match !!! 1 |
| return $ matchAllStrings variableNameRegex offsets |
| where |
| re = mkRegex "^(\\[.+\\])? *:([^-=?+].*)" |
| |
| getReferencedVariables parents t = |
| case t of |
| T_DollarBraced id l -> let str = bracedString t in |
| (t, t, getBracedReference str) : |
| map (\x -> (l, l, x)) ( |
| getIndexReferences str |
| ++ getOffsetReferences (getBracedModifier str)) |
| TA_Variable id name _ -> |
| if isArithmeticAssignment t |
| then [] |
| else [(t, t, name)] |
| T_Assignment id mode str _ word -> |
| [(t, t, str) | mode == Append] ++ specialReferences str t word |
| |
| TC_Unary id _ "-v" token -> getIfReference t token |
| TC_Unary id _ "-R" token -> getIfReference t token |
| TC_Binary id DoubleBracket op lhs rhs -> |
| if isDereferencing op |
| then concatMap (getIfReference t) [lhs, rhs] |
| else [] |
| |
| t@(T_FdRedirect _ ('{':var) op) -> -- {foo}>&- references and closes foo |
| [(t, t, takeWhile (/= '}') var) | isClosingFileOp op] |
| x -> getReferencedVariableCommand x |
| where |
| -- Try to reduce false positives for unused vars only referenced from evaluated vars |
| specialReferences name base word = |
| if name `elem` [ |
| "PS1", "PS2", "PS3", "PS4", |
| "PROMPT_COMMAND" |
| ] |
| then |
| map (\x -> (base, base, x)) $ |
| getVariablesFromLiteralToken word |
| else [] |
| |
| literalizer t = case t of |
| T_Glob _ s -> return s -- Also when parsed as globs |
| _ -> Nothing |
| |
| getIfReference context token = maybeToList $ do |
| str <- getLiteralStringExt literalizer token |
| guard . not $ null str |
| when (isDigit $ head str) $ fail "is a number" |
| return (context, token, getBracedReference str) |
| |
| isDereferencing = (`elem` ["-eq", "-ne", "-lt", "-le", "-gt", "-ge"]) |
| |
| isArithmeticAssignment t = case getPath parents t of |
| this: TA_Assignment _ "=" lhs _ :_ -> lhs == t |
| _ -> False |
| |
| dataTypeFrom defaultType v = (case v of T_Array {} -> DataArray; _ -> defaultType) $ SourceFrom [v] |
| |
| |
| --- Command specific checks |
| |
| -- Compare a command to a string: t `isCommand` "sed" (also matches /usr/bin/sed) |
| isCommand token str = isCommandMatch token (\cmd -> cmd == str || ('/' : str) `isSuffixOf` cmd) |
| |
| -- Compare a command to a literal. Like above, but checks full path. |
| isUnqualifiedCommand token str = isCommandMatch token (== str) |
| |
| isCommandMatch token matcher = fromMaybe False $ |
| fmap matcher (getCommandName token) |
| |
| -- Does this regex look like it was intended as a glob? |
| -- True: *foo* |
| -- False: .*foo.* |
| isConfusedGlobRegex :: String -> Bool |
| isConfusedGlobRegex ('*':_) = True |
| isConfusedGlobRegex [x,'*'] | x /= '\\' = True |
| isConfusedGlobRegex _ = False |
| |
| isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x |
| isVariableChar x = isVariableStartChar x || isDigit x |
| variableNameRegex = mkRegex "[_a-zA-Z][_a-zA-Z0-9]*" |
| |
| prop_isVariableName1 = isVariableName "_fo123" |
| prop_isVariableName2 = not $ isVariableName "4" |
| prop_isVariableName3 = not $ isVariableName "test: " |
| isVariableName (x:r) = isVariableStartChar x && all isVariableChar r |
| isVariableName _ = False |
| |
| getVariablesFromLiteralToken token = |
| getVariablesFromLiteral (fromJust $ getLiteralStringExt (const $ return " ") token) |
| |
| -- Try to get referenced variables from a literal string like "$foo" |
| -- Ignores tons of cases like arithmetic evaluation and array indices. |
| prop_getVariablesFromLiteral1 = |
| getVariablesFromLiteral "$foo${bar//a/b}$BAZ" == ["foo", "bar", "BAZ"] |
| getVariablesFromLiteral string = |
| map (!! 0) $ matchAllSubgroups variableRegex string |
| where |
| variableRegex = mkRegex "\\$\\{?([A-Za-z0-9_]+)" |
| |
| -- Get the variable name from an expansion like ${var:-foo} |
| prop_getBracedReference1 = getBracedReference "foo" == "foo" |
| prop_getBracedReference2 = getBracedReference "#foo" == "foo" |
| prop_getBracedReference3 = getBracedReference "#" == "#" |
| prop_getBracedReference4 = getBracedReference "##" == "#" |
| prop_getBracedReference5 = getBracedReference "#!" == "!" |
| prop_getBracedReference6 = getBracedReference "!#" == "#" |
| prop_getBracedReference7 = getBracedReference "!foo#?" == "foo" |
| prop_getBracedReference8 = getBracedReference "foo-bar" == "foo" |
| prop_getBracedReference9 = getBracedReference "foo:-bar" == "foo" |
| prop_getBracedReference10= getBracedReference "foo: -1" == "foo" |
| prop_getBracedReference11= getBracedReference "!os*" == "" |
| prop_getBracedReference12= getBracedReference "!os?bar**" == "" |
| prop_getBracedReference13= getBracedReference "foo[bar]" == "foo" |
| getBracedReference s = fromMaybe s $ |
| nameExpansion s `mplus` takeName noPrefix `mplus` getSpecial noPrefix `mplus` getSpecial s |
| where |
| noPrefix = dropPrefix s |
| dropPrefix (c:rest) = if c `elem` "!#" then rest else c:rest |
| dropPrefix "" = "" |
| takeName s = do |
| let name = takeWhile isVariableChar s |
| guard . not $ null name |
| return name |
| getSpecial (c:_) = |
| if c `elem` "*@#?-$!" then return [c] else fail "not special" |
| getSpecial _ = fail "empty" |
| |
| nameExpansion ('!':rest) = do -- e.g. ${!foo*bar*} |
| let suffix = dropWhile isVariableChar rest |
| guard $ suffix /= rest -- e.g. ${!@} |
| first <- suffix !!! 0 |
| guard $ first `elem` "*?" |
| return "" |
| nameExpansion _ = Nothing |
| |
| prop_getBracedModifier1 = getBracedModifier "foo:bar:baz" == ":bar:baz" |
| prop_getBracedModifier2 = getBracedModifier "!var:-foo" == ":-foo" |
| prop_getBracedModifier3 = getBracedModifier "foo[bar]" == "[bar]" |
| getBracedModifier s = fromMaybe "" . listToMaybe $ do |
| let var = getBracedReference s |
| a <- dropModifier s |
| dropPrefix var a |
| where |
| dropPrefix [] t = return t |
| dropPrefix (a:b) (c:d) | a == c = dropPrefix b d |
| dropPrefix _ _ = [] |
| |
| dropModifier (c:rest) | c `elem` "#!" = [rest, c:rest] |
| dropModifier x = [x] |
| |
| -- Useful generic functions. |
| |
| -- Run an action in a Maybe (or do nothing). |
| -- Example: |
| -- potentially $ do |
| -- s <- getLiteralString cmd |
| -- guard $ s `elem` ["--recursive", "-r"] |
| -- return $ warn .. "Something something recursive" |
| potentially :: Monad m => Maybe (m ()) -> m () |
| potentially = fromMaybe (return ()) |
| |
| -- Get element 0 or a default. Like `head` but safe. |
| headOrDefault _ (a:_) = a |
| headOrDefault def _ = def |
| |
| --- Get element n of a list, or Nothing. Like `!!` but safe. |
| (!!!) list i = |
| case drop i list of |
| [] -> Nothing |
| (r:_) -> Just r |
| |
| -- Run a command if the shell is in the given list |
| whenShell l c = do |
| shell <- asks shellType |
| when (shell `elem` l ) c |
| |
| |
| filterByAnnotation asSpec params = |
| filter (not . shouldIgnore) |
| where |
| token = asScript asSpec |
| shouldIgnore note = |
| any (shouldIgnoreFor (getCode note)) $ |
| getPath parents (T_Bang $ tcId note) |
| shouldIgnoreFor num (T_Annotation _ anns _) = |
| any hasNum anns |
| where |
| hasNum (DisableComment ts) = num == ts |
| hasNum _ = False |
| shouldIgnoreFor _ T_Include {} = not $ asCheckSourced asSpec |
| shouldIgnoreFor _ _ = False |
| parents = parentMap params |
| getCode = cCode . tcComment |
| |
| -- Is this a ${#anything}, to get string length or array count? |
| isCountingReference (T_DollarBraced id token) = |
| case concat $ oversimplify token of |
| '#':_ -> True |
| _ -> False |
| isCountingReference _ = False |
| |
| -- FIXME: doesn't handle ${a:+$var} vs ${a:+"$var"} |
| isQuotedAlternativeReference t = |
| case t of |
| T_DollarBraced _ _ -> |
| getBracedModifier (bracedString t) `matches` re |
| _ -> False |
| where |
| re = mkRegex "(^|\\]):?\\+" |
| |
| -- getGnuOpts "erd:u:" will parse a SimpleCommand like |
| -- read -re -d : -u 3 bar |
| -- into |
| -- Just [("r", -re), ("e", -re), ("d", :), ("u", 3), ("", bar)] |
| -- where flags with arguments map to arguments, while others map to themselves. |
| -- Any unrecognized flag will result in Nothing. |
| getGnuOpts = getOpts getAllFlags |
| getBsdOpts = getOpts getLeadingFlags |
| getOpts :: (Token -> [(Token, String)]) -> String -> Token -> Maybe [(String, Token)] |
| getOpts flagTokenizer string cmd = process flags |
| where |
| flags = flagTokenizer cmd |
| flagList (c:':':rest) = ([c], True) : flagList rest |
| flagList (c:rest) = ([c], False) : flagList rest |
| flagList [] = [] |
| flagMap = Map.fromList $ ("", False) : flagList string |
| |
| process [] = return [] |
| process [(token, flag)] = do |
| takesArg <- Map.lookup flag flagMap |
| guard $ not takesArg |
| return [(flag, token)] |
| process ((token1, flag1):rest2@((token2, flag2):rest)) = do |
| takesArg <- Map.lookup flag1 flagMap |
| if takesArg |
| then do |
| guard $ flag2 == "" |
| more <- process rest |
| return $ (flag1, token2) : more |
| else do |
| more <- process rest2 |
| return $ (flag1, token1) : more |
| |
| return [] |
| runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) |