1{-
2    Copyright 2012-2021 Vidar Holen
3
4    This file is part of ShellCheck.
5    https://www.shellcheck.net
6
7    ShellCheck is free software: you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation, either version 3 of the License, or
10    (at your option) any later version.
11
12    ShellCheck is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <https://www.gnu.org/licenses/>.
19-}
20{-# LANGUAGE FlexibleContexts #-}
21{-# LANGUAGE TemplateHaskell  #-}
22module ShellCheck.AnalyzerLib where
23
24import ShellCheck.AST
25import ShellCheck.ASTLib
26import ShellCheck.Data
27import ShellCheck.Interface
28import ShellCheck.Parser
29import ShellCheck.Regex
30
31import Control.Arrow (first)
32import Control.DeepSeq
33import Control.Monad.Identity
34import Control.Monad.RWS
35import Control.Monad.State
36import Control.Monad.Writer
37import Data.Char
38import Data.List
39import Data.Maybe
40import Data.Semigroup
41import qualified Data.Map as Map
42
43import Test.QuickCheck.All (forAllProperties)
44import Test.QuickCheck.Test (maxSuccess, quickCheckWithResult, stdArgs)
45
46type Analysis = AnalyzerM ()
47type AnalyzerM a = RWS Parameters [TokenComment] Cache a
48nullCheck = const $ return ()
49
50
51data Checker = Checker {
52    perScript :: Root -> Analysis,
53    perToken  :: Token -> Analysis
54}
55
56runChecker :: Parameters -> Checker -> [TokenComment]
57runChecker params checker = notes
58    where
59        root = rootNode params
60        check = perScript checker `composeAnalyzers` (\(Root x) -> void $ doAnalysis (perToken checker) x)
61        notes = snd $ evalRWS (check $ Root root) params Cache
62
63instance Semigroup Checker where
64    (<>) x y = Checker {
65        perScript = perScript x `composeAnalyzers` perScript y,
66        perToken = perToken x `composeAnalyzers` perToken y
67        }
68
69instance Monoid Checker where
70    mempty = Checker {
71        perScript = nullCheck,
72        perToken = nullCheck
73        }
74    mappend = (Data.Semigroup.<>)
75
76composeAnalyzers :: (a -> Analysis) -> (a -> Analysis) -> a -> Analysis
77composeAnalyzers f g x = f x >> g x
78
79data Parameters = Parameters {
80    -- Whether this script has the 'lastpipe' option set/default.
81    hasLastpipe        :: Bool,
82    -- Whether this script has the 'inherit_errexit' option set/default.
83    hasInheritErrexit  :: Bool,
84    -- Whether this script has 'set -e' anywhere.
85    hasSetE            :: Bool,
86    -- Whether this script has 'set -o pipefail' anywhere.
87    hasPipefail        :: Bool,
88    -- A linear (bad) analysis of data flow
89    variableFlow       :: [StackData],
90    -- A map from Id to parent Token
91    parentMap          :: Map.Map Id Token,
92    -- The shell type, such as Bash or Ksh
93    shellType          :: Shell,
94    -- True if shell type was forced via flags
95    shellTypeSpecified :: Bool,
96    -- The root node of the AST
97    rootNode           :: Token,
98    -- map from token id to start and end position
99    tokenPositions     :: Map.Map Id (Position, Position)
100    } deriving (Show)
101
102-- TODO: Cache results of common AST ops here
103data Cache = Cache {}
104
105data Scope = SubshellScope String | NoneScope deriving (Show, Eq)
106data StackData =
107    StackScope Scope
108    | StackScopeEnd
109    -- (Base expression, specific position, var name, assigned values)
110    | Assignment (Token, Token, String, DataType)
111    | Reference (Token, Token, String)
112  deriving (Show)
113
114data DataType = DataString DataSource | DataArray DataSource
115  deriving (Show)
116
117data DataSource =
118    SourceFrom [Token]
119    | SourceExternal
120    | SourceDeclaration
121    | SourceInteger
122    | SourceChecked
123  deriving (Show)
124
125data VariableState = Dead Token String | Alive deriving (Show)
126
127defaultSpec pr = spec {
128    asShellType = Nothing,
129    asCheckSourced = False,
130    asExecutionMode = Executed,
131    asTokenPositions = prTokenPositions pr
132} where spec = newAnalysisSpec (fromJust $ prRoot pr)
133
134pScript s =
135  let
136    pSpec = newParseSpec {
137        psFilename = "script",
138        psScript = s
139    }
140  in runIdentity $ parseScript (mockedSystemInterface []) pSpec
141
142-- For testing. If parsed, returns whether there are any comments
143producesComments :: Checker -> String -> Maybe Bool
144producesComments c s = do
145        let pr = pScript s
146        prRoot pr
147        let spec = defaultSpec pr
148        let params = makeParameters spec
149        return . not . null $ filterByAnnotation spec params $ runChecker params c
150
151makeComment :: Severity -> Id -> Code -> String -> TokenComment
152makeComment severity id code note =
153    newTokenComment {
154        tcId = id,
155        tcComment = newComment {
156            cSeverity = severity,
157            cCode = code,
158            cMessage = note
159        }
160    }
161
162addComment note = note `deepseq` tell [note]
163
164warn :: MonadWriter [TokenComment] m => Id -> Code -> String -> m ()
165warn  id code str = addComment $ makeComment WarningC id code str
166err   id code str = addComment $ makeComment ErrorC id code str
167info  id code str = addComment $ makeComment InfoC id code str
168style id code str = addComment $ makeComment StyleC id code str
169
170errWithFix :: MonadWriter [TokenComment] m => Id -> Code -> String -> Fix -> m ()
171errWithFix  = addCommentWithFix ErrorC
172warnWithFix :: MonadWriter [TokenComment] m => Id -> Code -> String -> Fix -> m ()
173warnWithFix  = addCommentWithFix WarningC
174infoWithFix :: MonadWriter [TokenComment] m => Id -> Code -> String -> Fix -> m ()
175infoWithFix = addCommentWithFix InfoC
176styleWithFix :: MonadWriter [TokenComment] m => Id -> Code -> String -> Fix -> m ()
177styleWithFix = addCommentWithFix StyleC
178
179addCommentWithFix :: MonadWriter [TokenComment] m => Severity -> Id -> Code -> String -> Fix -> m ()
180addCommentWithFix severity id code str fix =
181    addComment $ makeCommentWithFix severity id code str fix
182
183makeCommentWithFix :: Severity -> Id -> Code -> String -> Fix -> TokenComment
184makeCommentWithFix severity id code str fix =
185    let comment = makeComment severity id code str
186        withFix = comment {
187            -- If fix is empty, pretend it wasn't there.
188            tcFix = if null (fixReplacements fix) then Nothing else Just fix
189        }
190    in force withFix
191
192makeParameters spec =
193    let params = Parameters {
194        rootNode = root,
195        shellType = fromMaybe (determineShell (asFallbackShell spec) root) $ asShellType spec,
196        hasSetE = containsSetE root,
197        hasLastpipe =
198            case shellType params of
199                Bash -> containsLastpipe root
200                Dash -> False
201                Sh   -> False
202                Ksh  -> True,
203        hasInheritErrexit =
204            case shellType params of
205                Bash -> containsInheritErrexit root
206                Dash -> True
207                Sh   -> True
208                Ksh  -> False,
209        hasPipefail =
210            case shellType params of
211                Bash -> containsPipefail root
212                Dash -> True
213                Sh   -> True
214                Ksh  -> containsPipefail root,
215        shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec),
216        parentMap = getParentTree root,
217        variableFlow = getVariableFlow params root,
218        tokenPositions = asTokenPositions spec
219    } in params
220  where root = asScript spec
221
222
223-- Does this script mention 'set -e' anywhere?
224-- Used as a hack to disable certain warnings.
225containsSetE root = isNothing $ doAnalysis (guard . not . isSetE) root
226  where
227    isSetE t =
228        case t of
229            T_Script _ (T_Literal _ str) _ -> str `matches` re
230            T_SimpleCommand {}  ->
231                t `isUnqualifiedCommand` "set" &&
232                    ("errexit" `elem` oversimplify t ||
233                        "e" `elem` map snd (getAllFlags t))
234            _ -> False
235    re = mkRegex "[[:space:]]-[^-]*e"
236
237containsPipefail root = isNothing $ doAnalysis (guard . not . isPipefail) root
238  where
239    isPipefail t =
240        case t of
241            T_SimpleCommand {}  ->
242                t `isUnqualifiedCommand` "set" &&
243                    ("pipefail" `elem` oversimplify t ||
244                        "o" `elem` map snd (getAllFlags t))
245            _ -> False
246
247containsShopt shopt root =
248        isNothing $ doAnalysis (guard . not . isShoptLastPipe) root
249    where
250        isShoptLastPipe t =
251            case t of
252                T_SimpleCommand {}  ->
253                    t `isUnqualifiedCommand` "shopt" &&
254                        (shopt `elem` oversimplify t)
255                _ -> False
256
257-- Does this script mention 'shopt -s inherit_errexit' anywhere?
258containsInheritErrexit = containsShopt "inherit_errexit"
259
260-- Does this script mention 'shopt -s lastpipe' anywhere?
261-- Also used as a hack.
262containsLastpipe = containsShopt "lastpipe"
263
264
265prop_determineShell0 = determineShellTest "#!/bin/sh" == Sh
266prop_determineShell1 = determineShellTest "#!/usr/bin/env ksh" == Ksh
267prop_determineShell2 = determineShellTest "" == Bash
268prop_determineShell3 = determineShellTest "#!/bin/sh -e" == Sh
269prop_determineShell4 = determineShellTest "#!/bin/ksh\n#shellcheck shell=sh\nfoo" == Sh
270prop_determineShell5 = determineShellTest "#shellcheck shell=sh\nfoo" == Sh
271prop_determineShell6 = determineShellTest "#! /bin/sh" == Sh
272prop_determineShell7 = determineShellTest "#! /bin/ash" == Dash
273prop_determineShell8 = determineShellTest' (Just Ksh) "#!/bin/sh" == Sh
274prop_determineShell9 = determineShellTest "#!/bin/env -S dash -x" == Dash
275prop_determineShell10 = determineShellTest "#!/bin/env --split-string= dash -x" == Dash
276prop_determineShell11 = determineShellTest "#!/bin/busybox sh" == Dash -- busybox sh is a specific shell, not posix sh
277prop_determineShell12 = determineShellTest "#!/bin/busybox ash" == Dash
278
279determineShellTest = determineShellTest' Nothing
280determineShellTest' fallbackShell = determineShell fallbackShell . fromJust . prRoot . pScript
281determineShell fallbackShell t = fromMaybe Bash $
282    shellForExecutable shellString `mplus` fallbackShell
283  where
284    shellString = getCandidate t
285    getCandidate :: Token -> String
286    getCandidate t@T_Script {} = fromShebang t
287    getCandidate (T_Annotation _ annotations s) =
288        headOrDefault (fromShebang s) [s | ShellOverride s <- annotations]
289    fromShebang (T_Script _ (T_Literal _ s) _) = executableFromShebang s
290
291-- Given a root node, make a map from Id to parent Token.
292-- This is used to populate parentMap in Parameters
293getParentTree :: Token -> Map.Map Id Token
294getParentTree t =
295    snd $ execState (doStackAnalysis pre post t) ([], Map.empty)
296  where
297    pre t = modify (first ((:) t))
298    post t = do
299        (x, map) <- get
300        case x of
301          _:rest -> case rest of []    -> put (rest, map)
302                                 (x:_) -> put (rest, Map.insert (getId t) x map)
303
304-- Given a root node, make a map from Id to Token
305getTokenMap :: Token -> Map.Map Id Token
306getTokenMap t =
307    execState (doAnalysis f t) Map.empty
308  where
309    f t = modify (Map.insert (getId t) t)
310
311
312-- Is this token in a quoting free context? (i.e. would variable expansion split)
313-- True:  Assignments, [[ .. ]], here docs, already in double quotes
314-- False: Regular words
315isStrictlyQuoteFree = isQuoteFreeNode True
316
317-- Like above, but also allow some cases where splitting may be desired.
318-- True:  Like above + for loops
319-- False: Like above
320isQuoteFree = isQuoteFreeNode False
321
322
323isQuoteFreeNode strict shell tree t =
324    isQuoteFreeElement t ||
325        (fromMaybe False $ msum $ map isQuoteFreeContext $ drop 1 $ getPath tree t)
326  where
327    -- Is this node self-quoting in itself?
328    isQuoteFreeElement t =
329        case t of
330            T_Assignment {} -> assignmentIsQuoting t
331            T_FdRedirect {} -> True
332            _               -> False
333
334    -- Are any subnodes inherently self-quoting?
335    isQuoteFreeContext t =
336        case t of
337            TC_Nullary _ DoubleBracket _    -> return True
338            TC_Unary _ DoubleBracket _ _    -> return True
339            TC_Binary _ DoubleBracket _ _ _ -> return True
340            TA_Sequence {}                  -> return True
341            T_Arithmetic {}                 -> return True
342            T_Assignment {}                 -> return $ assignmentIsQuoting t
343            T_Redirecting {}                -> return False
344            T_DoubleQuoted _ _              -> return True
345            T_DollarDoubleQuoted _ _        -> return True
346            T_CaseExpression {}             -> return True
347            T_HereDoc {}                    -> return True
348            T_DollarBraced {}               -> return True
349            -- When non-strict, pragmatically assume it's desirable to split here
350            T_ForIn {}                      -> return (not strict)
351            T_SelectIn {}                   -> return (not strict)
352            _                               -> Nothing
353
354    -- Check whether this assigment is self-quoting due to being a recognized
355    -- assignment passed to a Declaration Utility. This will soon be required
356    -- by POSIX: https://austingroupbugs.net/view.php?id=351
357    assignmentIsQuoting t = shellParsesParamsAsAssignments || not (isAssignmentParamToCommand t)
358    shellParsesParamsAsAssignments = shell /= Sh
359
360    -- Is this assignment a parameter to a command like export/typeset/etc?
361    isAssignmentParamToCommand (T_Assignment id _ _ _ _) =
362        case Map.lookup id tree of
363            Just (T_SimpleCommand _ _ (_:args)) -> id `elem` (map getId args)
364            _ -> False
365
366-- Check if a token is a parameter to a certain command by name:
367-- Example: isParamTo (parentMap params) "sed" t
368isParamTo :: Map.Map Id Token -> String -> Token -> Bool
369isParamTo tree cmd =
370    go
371  where
372    go x = case Map.lookup (getId x) tree of
373                Nothing     -> False
374                Just parent -> check parent
375    check t =
376        case t of
377            T_SingleQuoted _ _ -> go t
378            T_DoubleQuoted _ _ -> go t
379            T_NormalWord _ _   -> go t
380            T_SimpleCommand {} -> isCommand t cmd
381            T_Redirecting {}   -> isCommand t cmd
382            _                  -> False
383
384-- Get the parent command (T_Redirecting) of a Token, if any.
385getClosestCommand :: Map.Map Id Token -> Token -> Maybe Token
386getClosestCommand tree t =
387    findFirst findCommand $ getPath tree t
388  where
389    findCommand t =
390        case t of
391            T_Redirecting {} -> return True
392            T_Script {}      -> return False
393            _                -> Nothing
394
395-- Like above, if koala_man knew Haskell when starting this project.
396getClosestCommandM t = do
397    params <- ask
398    return $ getClosestCommand (parentMap params) t
399
400-- Is the token used as a command name (the first word in a T_SimpleCommand)?
401usedAsCommandName tree token = go (getId token) (tail $ getPath tree token)
402  where
403    go currentId (T_NormalWord id [word]:rest)
404        | currentId == getId word = go id rest
405    go currentId (T_DoubleQuoted id [word]:rest)
406        | currentId == getId word = go id rest
407    go currentId (t@(T_SimpleCommand _ _ (word:_)):_) =
408        getId word == currentId || getId (getCommandTokenOrThis t) == currentId
409    go _ _ = False
410
411-- A list of the element and all its parents up to the root node.
412getPath tree t = t :
413    case Map.lookup (getId t) tree of
414        Nothing     -> []
415        Just parent -> getPath tree parent
416
417-- Version of the above taking the map from the current context
418-- Todo: give this the name "getPath"
419getPathM t = do
420    params <- ask
421    return $ getPath (parentMap params) t
422
423isParentOf tree parent child =
424    elem (getId parent) . map getId $ getPath tree child
425
426parents params = getPath (parentMap params)
427
428-- Find the first match in a list where the predicate is Just True.
429-- Stops if it's Just False and ignores Nothing.
430findFirst :: (a -> Maybe Bool) -> [a] -> Maybe a
431findFirst p = foldr go Nothing
432  where
433    go x acc =
434      case p x of
435        Just True  -> return x
436        Just False -> Nothing
437        Nothing    -> acc
438
439-- Check whether a word is entirely output from a single command
440tokenIsJustCommandOutput t = case t of
441    T_NormalWord id [T_DollarExpansion _ cmds] -> check cmds
442    T_NormalWord id [T_DoubleQuoted _ [T_DollarExpansion _ cmds]] -> check cmds
443    T_NormalWord id [T_Backticked _ cmds] -> check cmds
444    T_NormalWord id [T_DoubleQuoted _ [T_Backticked _ cmds]] -> check cmds
445    _ -> False
446  where
447    check [x] = not $ isOnlyRedirection x
448    check _   = False
449
450-- TODO: Replace this with a proper Control Flow Graph
451getVariableFlow params t =
452    reverse $ execState (doStackAnalysis startScope endScope t) []
453  where
454    startScope t =
455        let scopeType = leadType params t
456        in do
457            when (scopeType /= NoneScope) $ modify (StackScope scopeType:)
458            when (assignFirst t) $ setWritten t
459
460    endScope t =
461        let scopeType = leadType params t
462        in do
463            setRead t
464            unless (assignFirst t) $ setWritten t
465            when (scopeType /= NoneScope) $ modify (StackScopeEnd:)
466
467    assignFirst T_ForIn {}    = True
468    assignFirst T_SelectIn {} = True
469    assignFirst (T_BatsTest {}) = True
470    assignFirst _             = False
471
472    setRead t =
473        let read    = getReferencedVariables (parentMap params) t
474        in mapM_ (\v -> modify (Reference v:)) read
475
476    setWritten t =
477        let written = getModifiedVariables t
478        in mapM_ (\v -> modify (Assignment v:)) written
479
480
481leadType params t =
482    case t of
483        T_DollarExpansion _ _  -> SubshellScope "$(..) expansion"
484        T_Backticked _ _  -> SubshellScope "`..` expansion"
485        T_Backgrounded _ _  -> SubshellScope "backgrounding &"
486        T_Subshell _ _  -> SubshellScope "(..) group"
487        T_BatsTest {} -> SubshellScope "@bats test"
488        T_CoProcBody _ _  -> SubshellScope "coproc"
489        T_Redirecting {}  ->
490            if causesSubshell == Just True
491            then SubshellScope "pipeline"
492            else NoneScope
493        _ -> NoneScope
494  where
495    parentPipeline = do
496        parent <- Map.lookup (getId t) (parentMap params)
497        case parent of
498            T_Pipeline {} -> return parent
499            _             -> Nothing
500
501    causesSubshell = do
502        (T_Pipeline _ _ list) <- parentPipeline
503        return $ case list of
504            _:_:_ -> not (hasLastpipe params) || getId (last list) /= getId t
505            _ -> False
506
507getModifiedVariables t =
508    case t of
509        T_SimpleCommand _ vars [] ->
510            [(x, x, name, dataTypeFrom DataString w) | x@(T_Assignment id _ name _ w) <- vars]
511        T_SimpleCommand {} ->
512            getModifiedVariableCommand t
513
514        TA_Unary _ "++|" v@(TA_Variable _ name _)  ->
515            [(t, v, name, DataString $ SourceFrom [v])]
516        TA_Unary _ "|++" v@(TA_Variable _ name _)  ->
517            [(t, v, name, DataString $ SourceFrom [v])]
518        TA_Assignment _ op (TA_Variable _ name _) rhs -> do
519            guard $ op `elem` ["=", "*=", "/=", "%=", "+=", "-=", "<<=", ">>=", "&=", "^=", "|="]
520            return (t, t, name, DataString $ SourceFrom [rhs])
521
522        T_BatsTest {} -> [
523            (t, t, "lines", DataArray SourceExternal),
524            (t, t, "status", DataString SourceInteger),
525            (t, t, "output", DataString SourceExternal)
526            ]
527
528        -- Count [[ -v foo ]] as an "assignment".
529        -- This is to prevent [ -v foo ] being unassigned or unused.
530        TC_Unary id _ "-v" token -> maybeToList $ do
531            str <- getVariableForTestDashV token
532            return (t, token, str, DataString SourceChecked)
533
534        TC_Unary _ _ "-n" token -> markAsChecked t token
535        TC_Unary _ _ "-z" token -> markAsChecked t token
536        TC_Nullary _ _ token -> markAsChecked t token
537
538        T_DollarBraced _ _ l -> maybeToList $ do
539            let string = concat $ oversimplify l
540            let modifier = getBracedModifier string
541            guard $ any (`isPrefixOf` modifier) ["=", ":="]
542            return (t, t, getBracedReference string, DataString $ SourceFrom [l])
543
544        T_FdRedirect _ ('{':var) op -> -- {foo}>&2 modifies foo
545            [(t, t, takeWhile (/= '}') var, DataString SourceInteger) | not $ isClosingFileOp op]
546
547        T_CoProc _ name _ ->
548            [(t, t, fromMaybe "COPROC" name, DataArray SourceInteger)]
549
550        --Points to 'for' rather than variable
551        T_ForIn id str [] _ -> [(t, t, str, DataString SourceExternal)]
552        T_ForIn id str words _ -> [(t, t, str, DataString $ SourceFrom words)]
553        T_SelectIn id str words _ -> [(t, t, str, DataString $ SourceFrom words)]
554        _ -> []
555  where
556    markAsChecked place token = mapMaybe (f place) $ getWordParts token
557    f place t = case t of
558            T_DollarBraced _ _ l ->
559                let str = getBracedReference $ concat $ oversimplify l in do
560                    guard $ isVariableName str
561                    return (place, t, str, DataString SourceChecked)
562            _ -> Nothing
563
564isClosingFileOp op =
565    case op of
566        T_IoDuplicate _ (T_GREATAND _) "-" -> True
567        T_IoDuplicate _ (T_LESSAND  _) "-" -> True
568        _                                  -> False
569
570
571-- Consider 'export/declare -x' a reference, since it makes the var available
572getReferencedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Literal _ x:_):rest)) =
573    case x of
574        "declare" -> forDeclare
575        "typeset" -> forDeclare
576
577        "export" -> if "f" `elem` flags
578            then []
579            else concatMap getReference rest
580        "local" -> if "x" `elem` flags
581            then concatMap getReference rest
582            else []
583        "trap" ->
584            case rest of
585                head:_ -> map (\x -> (base, head, x)) $ getVariablesFromLiteralToken head
586                _ -> []
587        "alias" -> [(base, token, name) | token <- rest, name <- getVariablesFromLiteralToken token]
588        _ -> []
589  where
590    forDeclare =
591            if
592                any (`elem` flags) ["x", "p"] &&
593                    (not $ any (`elem` flags) ["f", "F"])
594            then concatMap getReference rest
595            else []
596
597    getReference t@(T_Assignment _ _ name _ value) = [(t, t, name)]
598    getReference t@(T_NormalWord _ [T_Literal _ name]) | not ("-" `isPrefixOf` name) = [(t, t, name)]
599    getReference _ = []
600    flags = map snd $ getAllFlags base
601
602getReferencedVariableCommand _ = []
603
604-- The function returns a tuple consisting of four items describing an assignment.
605-- Given e.g. declare foo=bar
606-- (
607--   BaseCommand :: Token,     -- The command/structure assigning the variable, i.e. declare foo=bar
608--   AssignmentToken :: Token, -- The specific part that assigns this variable, i.e. foo=bar
609--   VariableName :: String,   -- The variable name, i.e. foo
610--   VariableValue :: DataType -- A description of the value being assigned, i.e. "Literal string with value foo"
611-- )
612getModifiedVariableCommand base@(T_SimpleCommand id cmdPrefix (T_NormalWord _ (T_Literal _ x:_):rest)) =
613   filter (\(_,_,s,_) -> not ("-" `isPrefixOf` s)) $
614    case x of
615        "builtin" ->
616            getModifiedVariableCommand $ T_SimpleCommand id cmdPrefix rest
617        "read" ->
618            let fallback = catMaybes $ takeWhile isJust (reverse $ map getLiteral rest)
619            in fromMaybe fallback $ do
620                parsed <- getGnuOpts flagsForRead rest
621                case lookup "a" parsed of
622                    Just (_, var) -> (:[]) <$> getLiteralArray var
623                    Nothing -> return $ catMaybes $
624                        map (getLiteral . snd . snd) $ filter (null . fst) parsed
625
626        "getopts" ->
627            case rest of
628                opts:var:_ -> maybeToList $ getLiteral var
629                _          -> []
630
631        "let" -> concatMap letParamToLiteral rest
632
633        "export" ->
634            if "f" `elem` flags then [] else concatMap getModifierParamString rest
635
636        "declare" -> forDeclare
637        "typeset" -> forDeclare
638
639        "local" -> concatMap getModifierParamString rest
640        "readonly" ->
641            if any (`elem` flags) ["f", "p"]
642            then []
643            else concatMap getModifierParamString rest
644        "set" -> maybeToList $ do
645            params <- getSetParams rest
646            return (base, base, "@", DataString $ SourceFrom params)
647
648        "printf" -> maybeToList $ getPrintfVariable rest
649        "wait" ->   maybeToList $ getWaitVariable rest
650
651        "mapfile" -> maybeToList $ getMapfileArray base rest
652        "readarray" -> maybeToList $ getMapfileArray base rest
653
654        "DEFINE_boolean" -> maybeToList $ getFlagVariable rest
655        "DEFINE_float" -> maybeToList $ getFlagVariable rest
656        "DEFINE_integer" -> maybeToList $ getFlagVariable rest
657        "DEFINE_string" -> maybeToList $ getFlagVariable rest
658
659        _ -> []
660  where
661    flags = map snd $ getAllFlags base
662    stripEquals s = drop 1 $ dropWhile (/= '=') s
663    stripEqualsFrom (T_NormalWord id1 (T_Literal id2 s:rs)) =
664        T_NormalWord id1 (T_Literal id2 (stripEquals s):rs)
665    stripEqualsFrom (T_NormalWord id1 [T_DoubleQuoted id2 [T_Literal id3 s]]) =
666        T_NormalWord id1 [T_DoubleQuoted id2 [T_Literal id3 (stripEquals s)]]
667    stripEqualsFrom t = t
668
669    forDeclare = if any (`elem` flags) ["F", "f", "p"] then [] else declaredVars
670
671    declaredVars = concatMap (getModifierParam defaultType) rest
672      where
673        defaultType = if any (`elem` flags) ["a", "A"] then DataArray else DataString
674
675    getLiteralOfDataType t d = do
676        s <- getLiteralString t
677        when ("-" `isPrefixOf` s) $ fail "argument"
678        return (base, t, s, d)
679
680    getLiteral t = getLiteralOfDataType t (DataString SourceExternal)
681
682    getLiteralArray t = getLiteralOfDataType t (DataArray SourceExternal)
683
684    getModifierParamString = getModifierParam DataString
685
686    getModifierParam def t@(T_Assignment _ _ name _ value) =
687        [(base, t, name, dataTypeFrom def value)]
688    getModifierParam def t@T_NormalWord {} = maybeToList $ do
689        name <- getLiteralString t
690        guard $ isVariableName name
691        return (base, t, name, def SourceDeclaration)
692    getModifierParam _ _ = []
693
694    letParamToLiteral token =
695          if null var
696            then []
697            else [(base, token, var, DataString $ SourceFrom [stripEqualsFrom token])]
698        where var = takeWhile isVariableChar $ dropWhile (`elem` "+-") $ concat $ oversimplify token
699
700    getSetParams (t:_:rest) | getLiteralString t == Just "-o" = getSetParams rest
701    getSetParams (t:rest) =
702        let s = getLiteralString t in
703            case s of
704                Just "--"    -> return rest
705                Just ('-':_) -> getSetParams rest
706                _            -> return (t:fromMaybe [] (getSetParams rest))
707    getSetParams [] = Nothing
708
709    getPrintfVariable list = getFlagAssignedVariable "v" (SourceFrom list) $ getBsdOpts "v:" list
710    getWaitVariable   list = getFlagAssignedVariable "p" SourceInteger     $ return $ getGenericOpts list
711
712    getFlagAssignedVariable str dataSource maybeFlags = do
713        flags <- maybeFlags
714        (_, (flag, value)) <- find ((== str) . fst) flags
715        variableName <- getLiteralStringExt (const $ return "!") value
716        let (baseName, index) = span (/= '[') variableName
717        return (base, value, baseName, (if null index then DataString else DataArray) dataSource)
718
719    -- mapfile has some curious syntax allowing flags plus 0..n variable names
720    -- where only the first non-option one is used if any.
721    getMapfileArray base rest = parseArgs `mplus` fallback
722      where
723        parseArgs :: Maybe (Token, Token, String, DataType)
724        parseArgs = do
725            args <- getGnuOpts "d:n:O:s:u:C:c:t" rest
726            case [y | ("",(_,y)) <- args] of
727                [] ->
728                    return (base, base, "MAPFILE", DataArray SourceExternal)
729                first:_ -> do
730                    name <- getLiteralString first
731                    guard $ isVariableName name
732                    return (base, first, name, DataArray SourceExternal)
733        -- If arg parsing fails (due to bad or new flags), get the last variable name
734        fallback :: Maybe (Token, Token, String, DataType)
735        fallback = do
736            (name, token) <- listToMaybe . mapMaybe f $ reverse rest
737            return (base, token, name, DataArray SourceExternal)
738        f arg = do
739            name <- getLiteralString arg
740            guard $ isVariableName name
741            return (name, arg)
742
743    -- get the FLAGS_ variable created by a shflags DEFINE_ call
744    getFlagVariable (n:v:_) = do
745        name <- getLiteralString n
746        return (base, n, "FLAGS_" ++ name, DataString $ SourceExternal)
747    getFlagVariable _ = Nothing
748
749getModifiedVariableCommand _ = []
750
751getIndexReferences s = fromMaybe [] $ do
752    match <- matchRegex re s
753    index <- match !!! 0
754    return $ matchAllStrings variableNameRegex index
755  where
756    re = mkRegex "(\\[.*\\])"
757
758-- Given a NormalWord like foo or foo[$bar], get foo.
759-- Primarily used to get references for [[ -v foo[bar] ]]
760getVariableForTestDashV :: Token -> Maybe String
761getVariableForTestDashV t = do
762    str <- takeWhile ('[' /=) <$> getLiteralStringExt toStr t
763    guard $ isVariableName str
764    return str
765  where
766    -- foo[bar] gets parsed with [bar] as a glob, so undo that
767    toStr (T_Glob _ s) = return s
768    -- Turn foo[$x] into foo[\0] so that we can get the constant array name
769    -- in a non-constant expression (while filtering out foo$x[$y])
770    toStr _ = return "\0"
771
772prop_getOffsetReferences1 = getOffsetReferences ":bar" == ["bar"]
773prop_getOffsetReferences2 = getOffsetReferences ":bar:baz" == ["bar", "baz"]
774prop_getOffsetReferences3 = getOffsetReferences "[foo]:bar" == ["bar"]
775prop_getOffsetReferences4 = getOffsetReferences "[foo]:bar:baz" == ["bar", "baz"]
776getOffsetReferences mods = fromMaybe [] $ do
777-- if mods start with [, then drop until ]
778    match <- matchRegex re mods
779    offsets <- match !!! 1
780    return $ matchAllStrings variableNameRegex offsets
781  where
782    re = mkRegex "^(\\[.+\\])? *:([^-=?+].*)"
783
784getReferencedVariables parents t =
785    case t of
786        T_DollarBraced id _ l -> let str = concat $ oversimplify l in
787            (t, t, getBracedReference str) :
788                map (\x -> (l, l, x)) (
789                    getIndexReferences str
790                    ++ getOffsetReferences (getBracedModifier str))
791        TA_Variable id name _ ->
792            if isArithmeticAssignment t
793            then []
794            else [(t, t, name)]
795        T_Assignment id mode str _ word ->
796            [(t, t, str) | mode == Append] ++ specialReferences str t word
797
798        TC_Unary id _ "-v" token -> getIfReference t token
799        TC_Unary id _ "-R" token -> getIfReference t token
800        TC_Binary id DoubleBracket op lhs rhs ->
801            if isDereferencingBinaryOp op
802            then concatMap (getIfReference t) [lhs, rhs]
803            else []
804
805        T_BatsTest {} -> [ -- pretend @test references vars to avoid warnings
806            (t, t, "lines"),
807            (t, t, "status"),
808            (t, t, "output")
809            ]
810
811        T_FdRedirect _ ('{':var) op -> -- {foo}>&- references and closes foo
812            [(t, t, takeWhile (/= '}') var) | isClosingFileOp op]
813        x -> getReferencedVariableCommand x
814  where
815    -- Try to reduce false positives for unused vars only referenced from evaluated vars
816    specialReferences name base word =
817        if name `elem` [
818            "PS1", "PS2", "PS3", "PS4",
819            "PROMPT_COMMAND"
820          ]
821        then
822            map (\x -> (base, base, x)) $
823                getVariablesFromLiteralToken word
824        else []
825
826    literalizer t = case t of
827        T_Glob _ s -> return s    -- Also when parsed as globs
828        _          -> []
829
830    getIfReference context token = maybeToList $ do
831            str <- getVariableForTestDashV token
832            return (context, token, getBracedReference str)
833
834    isArithmeticAssignment t = case getPath parents t of
835        this: TA_Assignment _ "=" lhs _ :_ -> lhs == t
836        _                                  -> False
837
838isDereferencingBinaryOp = (`elem` ["-eq", "-ne", "-lt", "-le", "-gt", "-ge"])
839
840dataTypeFrom defaultType v = (case v of T_Array {} -> DataArray; _ -> defaultType) $ SourceFrom [v]
841
842
843--- Command specific checks
844
845-- Compare a command to a string: t `isCommand` "sed" (also matches /usr/bin/sed)
846isCommand token str = isCommandMatch token (\cmd -> cmd  == str || ('/' : str) `isSuffixOf` cmd)
847
848-- Compare a command to a literal. Like above, but checks full path.
849isUnqualifiedCommand token str = isCommandMatch token (== str)
850
851isCommandMatch token matcher = maybe False
852    matcher (getCommandName token)
853
854-- Does this regex look like it was intended as a glob?
855-- True:  *foo*
856-- False: .*foo.*
857isConfusedGlobRegex :: String -> Bool
858isConfusedGlobRegex ('*':_) = True
859isConfusedGlobRegex [x,'*'] | x `notElem` "\\." = True
860isConfusedGlobRegex _       = False
861
862isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x
863isVariableChar x = isVariableStartChar x || isDigit x
864isSpecialVariableChar = (`elem` "*@#?-$!")
865variableNameRegex = mkRegex "[_a-zA-Z][_a-zA-Z0-9]*"
866
867prop_isVariableName1 = isVariableName "_fo123"
868prop_isVariableName2 = not $ isVariableName "4"
869prop_isVariableName3 = not $ isVariableName "test: "
870isVariableName (x:r) = isVariableStartChar x && all isVariableChar r
871isVariableName _     = False
872
873getVariablesFromLiteralToken token =
874    getVariablesFromLiteral (getLiteralStringDef " " token)
875
876-- Try to get referenced variables from a literal string like "$foo"
877-- Ignores tons of cases like arithmetic evaluation and array indices.
878prop_getVariablesFromLiteral1 =
879    getVariablesFromLiteral "$foo${bar//a/b}$BAZ" == ["foo", "bar", "BAZ"]
880getVariablesFromLiteral string =
881    map head $ matchAllSubgroups variableRegex string
882  where
883    variableRegex = mkRegex "\\$\\{?([A-Za-z0-9_]+)"
884
885-- Get the variable name from an expansion like ${var:-foo}
886prop_getBracedReference1 = getBracedReference "foo" == "foo"
887prop_getBracedReference2 = getBracedReference "#foo" == "foo"
888prop_getBracedReference3 = getBracedReference "#" == "#"
889prop_getBracedReference4 = getBracedReference "##" == "#"
890prop_getBracedReference5 = getBracedReference "#!" == "!"
891prop_getBracedReference6 = getBracedReference "!#" == "#"
892prop_getBracedReference7 = getBracedReference "!foo#?" == "foo"
893prop_getBracedReference8 = getBracedReference "foo-bar" == "foo"
894prop_getBracedReference9 = getBracedReference "foo:-bar" == "foo"
895prop_getBracedReference10= getBracedReference "foo: -1" == "foo"
896prop_getBracedReference11= getBracedReference "!os*" == ""
897prop_getBracedReference11b= getBracedReference "!os@" == ""
898prop_getBracedReference12= getBracedReference "!os?bar**" == ""
899prop_getBracedReference13= getBracedReference "foo[bar]" == "foo"
900getBracedReference s = fromMaybe s $
901    nameExpansion s `mplus` takeName noPrefix `mplus` getSpecial noPrefix `mplus` getSpecial s
902  where
903    noPrefix = dropPrefix s
904    dropPrefix (c:rest) | c `elem` "!#" = rest
905    dropPrefix cs = cs
906    takeName s = do
907        let name = takeWhile isVariableChar s
908        guard . not $ null name
909        return name
910    getSpecial (c:_) | isSpecialVariableChar c = return [c]
911    getSpecial _ = fail "empty or not special"
912
913    nameExpansion ('!':next:rest) = do -- e.g. ${!foo*bar*}
914        guard $ isVariableChar next -- e.g. ${!@}
915        first <- find (not . isVariableChar) rest
916        guard $ first `elem` "*?@"
917        return ""
918    nameExpansion _ = Nothing
919
920prop_getBracedModifier1 = getBracedModifier "foo:bar:baz" == ":bar:baz"
921prop_getBracedModifier2 = getBracedModifier "!var:-foo" == ":-foo"
922prop_getBracedModifier3 = getBracedModifier "foo[bar]" == "[bar]"
923prop_getBracedModifier4 = getBracedModifier "foo[@]@Q" == "[@]@Q"
924prop_getBracedModifier5 = getBracedModifier "@@Q" == "@Q"
925getBracedModifier s = headOrDefault "" $ do
926    let var = getBracedReference s
927    a <- dropModifier s
928    dropPrefix var a
929  where
930    dropPrefix [] t        = return t
931    dropPrefix (a:b) (c:d) | a == c = dropPrefix b d
932    dropPrefix _ _         = []
933
934    dropModifier (c:rest) | c `elem` "#!" = [rest, c:rest]
935    dropModifier x        = [x]
936
937-- Useful generic functions.
938
939-- Get element 0 or a default. Like `head` but safe.
940headOrDefault _ (a:_) = a
941headOrDefault def _   = def
942
943-- Get the last element or a default. Like `last` but safe.
944lastOrDefault def [] = def
945lastOrDefault _ list = last list
946
947--- Get element n of a list, or Nothing. Like `!!` but safe.
948(!!!) list i =
949    case drop i list of
950        []    -> Nothing
951        (r:_) -> Just r
952
953-- Run a command if the shell is in the given list
954whenShell l c = do
955    params <- ask
956    when (shellType params `elem` l ) c
957
958
959filterByAnnotation asSpec params =
960    filter (not . shouldIgnore)
961  where
962    token = asScript asSpec
963    shouldIgnore note =
964        any (shouldIgnoreFor (getCode note)) $
965            getPath parents (T_Bang $ tcId note)
966    shouldIgnoreFor _ T_Include {} = not $ asCheckSourced asSpec
967    shouldIgnoreFor code t = isAnnotationIgnoringCode code t
968    parents = parentMap params
969    getCode = cCode . tcComment
970
971shouldIgnoreCode params code t =
972    any (isAnnotationIgnoringCode code) $
973        getPath (parentMap params) t
974
975-- Is this a ${#anything}, to get string length or array count?
976isCountingReference (T_DollarBraced id _ token) =
977    case concat $ oversimplify token of
978        '#':_ -> True
979        _     -> False
980isCountingReference _ = False
981
982-- FIXME: doesn't handle ${a:+$var} vs ${a:+"$var"}
983isQuotedAlternativeReference t =
984    case t of
985        T_DollarBraced _ _ l ->
986            getBracedModifier (concat $ oversimplify l) `matches` re
987        _ -> False
988  where
989    re = mkRegex "(^|\\]):?\\+"
990
991supportsArrays Bash = True
992supportsArrays Ksh = True
993supportsArrays _ = False
994
995-- Returns true if the shell is Bash or Ksh (sorry for the name, Ksh)
996isBashLike :: Parameters -> Bool
997isBashLike params =
998    case shellType params of
999        Bash -> True
1000        Ksh -> True
1001        Dash -> False
1002        Sh -> False
1003
1004-- Returns whether a token is a parameter expansion without any modifiers.
1005-- True for $var ${var} $1 $#
1006-- False for ${#var} ${var[x]} ${var:-0}
1007isUnmodifiedParameterExpansion t =
1008    case t of
1009        T_DollarBraced _ False _ -> True
1010        T_DollarBraced _ _ list ->
1011            let str = concat $ oversimplify list
1012            in getBracedReference str == str
1013        _ -> False
1014
1015isTrueAssignmentSource c =
1016    case c of
1017        DataString SourceChecked -> False
1018        DataString SourceDeclaration -> False
1019        DataArray SourceChecked -> False
1020        DataArray SourceDeclaration -> False
1021        _ -> True
1022
1023modifiesVariable params token name =
1024    or $ map check flow
1025  where
1026    flow = getVariableFlow params token
1027    check t =
1028        case t of
1029            Assignment (_, _, n, source) -> isTrueAssignmentSource source && n == name
1030            _ -> False
1031
1032
1033return []
1034runTests =  $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])
1035