ShellCheck-0.11.0: src/ShellCheck/ASTLib.hs
{-
Copyright 2012-2021 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 TemplateHaskell #-}
module ShellCheck.ASTLib where
import ShellCheck.AST
import ShellCheck.Prelude
import ShellCheck.Regex
import Control.Monad.Writer
import Control.Monad
import Data.Char
import Data.Functor
import Data.Functor.Identity
import Data.List
import Data.Maybe
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import Numeric (showHex)
import Test.QuickCheck
arguments (T_SimpleCommand _ _ (cmd:args)) = args
-- Is this a type of loop?
isLoop t = case t of
T_WhileExpression {} -> True
T_UntilExpression {} -> True
T_ForIn {} -> True
T_ForArithmetic {} -> True
T_SelectIn {} -> True
_ -> False
-- Will this split into multiple words when used as an argument?
willSplit x =
case x of
T_DollarBraced {} -> True
T_DollarExpansion {} -> True
T_Backticked {} -> True
T_BraceExpansion {} -> True
T_Glob {} -> True
T_Extglob {} -> True
T_DoubleQuoted _ l -> any willBecomeMultipleArgs l
T_NormalWord _ l -> any willSplit l
_ -> False
isGlob t = case t of
T_Extglob {} -> True
T_Glob {} -> True
T_NormalWord _ l -> any isGlob l || hasSplitRange l
_ -> False
where
-- foo[x${var}y] gets parsed as foo,[,x,$var,y],
-- so check if there's such an interval
hasSplitRange l =
let afterBracket = dropWhile (not . isHalfOpenRange) l
in any isClosingRange afterBracket
isHalfOpenRange t =
case t of
T_Literal _ "[" -> True
_ -> False
isClosingRange t =
case t of
T_Literal _ str -> ']' `elem` str
_ -> False
-- Is this shell word a constant?
isConstant token =
case token of
-- This ignores some cases like ~"foo":
T_NormalWord _ (T_Literal _ ('~':_) : _) -> False
T_NormalWord _ l -> all isConstant l
T_DoubleQuoted _ l -> all isConstant l
T_SingleQuoted _ _ -> True
T_Literal _ _ -> True
_ -> False
-- Is this an empty literal?
isEmpty token =
case token of
T_NormalWord _ l -> all isEmpty l
T_DoubleQuoted _ l -> all isEmpty l
T_SingleQuoted _ "" -> True
T_Literal _ "" -> True
_ -> False
-- Quick&lazy oversimplification of commands, throwing away details
-- and returning a list like ["find", ".", "-name", "${VAR}*" ].
oversimplify token =
case token of
(T_NormalWord _ l) -> [concat (concatMap oversimplify l)]
(T_DoubleQuoted _ l) -> [concat (concatMap oversimplify l)]
(T_SingleQuoted _ s) -> [s]
(T_DollarBraced _ _ _) -> ["${VAR}"]
(T_DollarArithmetic _ _) -> ["${VAR}"]
(T_DollarExpansion _ _) -> ["${VAR}"]
(T_Backticked _ _) -> ["${VAR}"]
(T_Glob _ s) -> [s]
(T_Pipeline _ _ [x]) -> oversimplify x
(T_Literal _ x) -> [x]
(T_ParamSubSpecialChar _ x) -> [x]
(T_SimpleCommand _ vars words) -> concatMap oversimplify words
(T_Redirecting _ _ foo) -> oversimplify foo
(T_DollarSingleQuoted _ s) -> [s]
(T_Annotation _ _ s) -> oversimplify s
-- Workaround for let "foo = bar" parsing
(TA_Sequence _ [TA_Expansion _ v]) -> concatMap oversimplify v
_ -> []
-- Turn a SimpleCommand foo -avz --bar=baz into args "a", "v", "z", "bar",
-- each in a tuple of (token, stringFlag). Non-flag arguments are added with
-- stringFlag == "".
getFlagsUntil stopCondition (T_SimpleCommand _ _ (_:args)) =
let tokenAndText = map (\x -> (x, concat $ oversimplify x)) args
(flagArgs, rest) = break (stopCondition . snd) tokenAndText
in
concatMap flag flagArgs ++ map (\(t, _) -> (t, "")) rest
where
flag (x, '-':'-':arg) = [ (x, takeWhile (/= '=') arg) ]
flag (x, '-':args) = map (\v -> (x, [v])) args
flag (x, _) = [ (x, "") ]
getFlagsUntil _ _ = error $ pleaseReport "getFlags on non-command"
-- Get all flags in a GNU way, up until --
getAllFlags :: Token -> [(Token, String)]
getAllFlags = getFlagsUntil (== "--")
-- Get all flags in a BSD way, up until first non-flag argument or --
getLeadingFlags = getFlagsUntil (\x -> x == "--" || (not $ "-" `isPrefixOf` x))
-- Check if a command has a flag.
hasFlag cmd str = str `elem` (map snd $ getAllFlags cmd)
-- Is this token a word that starts with a dash?
isFlag token =
case getWordParts token of
T_Literal _ ('-':_) : _ -> True
_ -> False
-- Is this token a flag where the - is unquoted?
isUnquotedFlag token =
case getLeadingUnquotedString token of
Just ('-':_) -> True
_ -> False
-- getGnuOpts "erd:u:" will parse a list of arguments tokens like `read`
-- -re -d : -u 3 bar
-- into
-- Just [("r", (-re, -re)), ("e", (-re, -re)), ("d", (-d,:)), ("u", (-u,3)), ("", (bar,bar))]
--
-- Each string flag maps to a tuple of (flag, argument), where argument=flag if it
-- doesn't take a specific one.
--
-- Any unrecognized flag will result in Nothing. The exception is if arbitraryLongOpts
-- is set, in which case --anything will map to "anything".
getGnuOpts :: String -> [Token] -> Maybe [(String, (Token, Token))]
getGnuOpts str args = getOpts (True, False) str [] args
-- As above, except the first non-arg string will treat the rest as arguments
getBsdOpts :: String -> [Token] -> Maybe [(String, (Token, Token))]
getBsdOpts str args = getOpts (False, False) str [] args
-- Tests for this are in Commands.hs where it's more frequently used
getOpts ::
-- Behavioral config: gnu style, allow arbitrary long options
(Bool, Bool)
-- A getopts style string
-> String
-- List of long options and whether they take arguments
-> [(String, Bool)]
-- List of arguments (excluding command)
-> [Token]
-- List of flags to tuple of (optionToken, valueToken)
-> Maybe [(String, (Token, Token))]
getOpts (gnu, arbitraryLongOpts) string longopts args = process args
where
flagList (c:':':rest) = ([c], True) : flagList rest
flagList (c:rest) = ([c], False) : flagList rest
flagList [] = longopts
flagMap = Map.fromList $ ("", False) : flagList string
process [] = return []
process (token:rest) = do
case getLiteralStringDef "\0" token of
"--" -> return $ listToArgs rest
'-':'-':word -> do
let (name, arg) = span (/= '=') word
needsArg <-
if arbitraryLongOpts
then return $ Map.findWithDefault False name flagMap
else Map.lookup name flagMap
if needsArg && null arg
then
case rest of
(arg:rest2) -> do
more <- process rest2
return $ (name, (token, arg)) : more
_ -> fail "Missing arg"
else do
more <- process rest
-- Consider splitting up token to get arg
return $ (name, (token, token)) : more
'-':opts -> shortToOpts opts token rest
arg ->
if gnu
then do
more <- process rest
return $ ("", (token, token)):more
else return $ listToArgs (token:rest)
shortToOpts opts token args =
case opts of
c:rest -> do
needsArg <- Map.lookup [c] flagMap
case () of
_ | needsArg && null rest -> do
(next:restArgs) <- return args
more <- process restArgs
return $ ([c], (token, next)):more
_ | needsArg -> do
more <- process args
return $ ([c], (token, token)):more
_ -> do
more <- shortToOpts rest token args
return $ ([c], (token, token)):more
[] -> process args
listToArgs = map (\x -> ("", (x, x)))
-- Generic getOpts that doesn't rely on a format string, but may also be inaccurate.
-- This provides a best guess interpretation instead of failing when new options are added.
--
-- "--" is treated as end of arguments
-- "--anything[=foo]" is treated as a long option without argument
-- "-any" is treated as -a -n -y, with the next arg as an option to -y unless it starts with -
-- anything else is an argument
getGenericOpts :: [Token] -> [(String, (Token, Token))]
getGenericOpts = process
where
process (token:rest) =
case getLiteralStringDef "\0" token of
"--" -> map (\c -> ("", (c,c))) rest
'-':'-':word -> (takeWhile (`notElem` "\0=") word, (token, token)) : process rest
'-':optString ->
let opts = takeWhile (/= '\0') optString
in
case rest of
next:_ | "-" `isPrefixOf` getLiteralStringDef "\0" next ->
map (\c -> ([c], (token, token))) opts ++ process rest
next:remainder ->
case reverse opts of
last:initial ->
map (\c -> ([c], (token, token))) (reverse initial)
++ [([last], (token, next))]
++ process remainder
[] -> process remainder
[] -> map (\c -> ([c], (token, token))) opts
_ -> ("", (token, token)) : process rest
process [] = []
-- Is this an expansion of multiple items of an array?
isArrayExpansion (T_DollarBraced _ _ l) =
let string = concat $ oversimplify l in
"@" `isPrefixOf` string ||
not ("#" `isPrefixOf` string) && "[@]" `isInfixOf` string
isArrayExpansion _ = False
-- Is it possible that this arg becomes multiple args?
mayBecomeMultipleArgs t = willBecomeMultipleArgs t || f False t
where
f quoted (T_DollarBraced _ _ l) =
let string = concat $ oversimplify l in
not quoted || "!" `isPrefixOf` string
f quoted (T_DoubleQuoted _ parts) = any (f True) parts
f quoted (T_NormalWord _ parts) = any (f quoted) parts
f _ _ = False
-- Is it certain that this word will becomes multiple words?
willBecomeMultipleArgs t = willConcatInAssignment t || f t
where
f T_Extglob {} = True
f T_Glob {} = True
f T_BraceExpansion {} = True
f (T_NormalWord _ parts) = any f parts
f _ = False
-- This does token cause implicit concatenation in assignments?
willConcatInAssignment token =
case token of
t@T_DollarBraced {} -> isArrayExpansion t
(T_DoubleQuoted _ parts) -> any willConcatInAssignment parts
(T_NormalWord _ parts) -> any willConcatInAssignment parts
_ -> False
-- Maybe get the literal string corresponding to this token
getLiteralString :: Token -> Maybe String
getLiteralString = getLiteralStringExt (const Nothing)
-- Definitely get a literal string, with a given default for all non-literals
getLiteralStringDef :: String -> Token -> String
getLiteralStringDef x = runIdentity . getLiteralStringExt (const $ return x)
-- Definitely get a literal string, skipping over all non-literals
onlyLiteralString :: Token -> String
onlyLiteralString = getLiteralStringDef ""
-- Maybe get a literal string, but only if it's an unquoted argument.
getUnquotedLiteral (T_NormalWord _ list) =
concat <$> mapM str list
where
str (T_Literal _ s) = return s
str _ = Nothing
getUnquotedLiteral _ = Nothing
isQuotes t =
case t of
T_DoubleQuoted {} -> True
T_SingleQuoted {} -> True
_ -> False
-- Get the last unquoted T_Literal in a word like "${var}foo"THIS
-- or nothing if the word does not end in an unquoted literal.
getTrailingUnquotedLiteral :: Token -> Maybe Token
getTrailingUnquotedLiteral t =
case t of
(T_NormalWord _ list@(_:_)) ->
from (last list)
_ -> Nothing
where
from t =
case t of
T_Literal {} -> return t
_ -> Nothing
-- Get the leading, unquoted, literal string of a token (if any).
getLeadingUnquotedString :: Token -> Maybe String
getLeadingUnquotedString t =
case t of
T_NormalWord _ ((T_Literal _ s) : rest) -> return $ s ++ from rest
_ -> Nothing
where
from ((T_Literal _ s):rest) = s ++ from rest
from _ = ""
-- Maybe get the literal string of this token and any globs in it.
getGlobOrLiteralString = getLiteralStringExt f
where
f (T_Glob _ str) = return str
f _ = Nothing
prop_getLiteralString1 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x01") == Just "\1"
prop_getLiteralString2 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\xyz") == Just "\\xyz"
prop_getLiteralString3 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x1") == Just "\x1"
prop_getLiteralString4 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x1y") == Just "\x1y"
prop_getLiteralString5 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\xy") == Just "\\xy"
prop_getLiteralString6 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x") == Just "\\x"
prop_getLiteralString7 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\1x") == Just "\1x"
prop_getLiteralString8 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\12x") == Just "\o12x"
prop_getLiteralString9 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\123x") == Just "\o123x"
prop_getLiteralString10 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\1234") == Just "\o123\&4"
prop_getLiteralString11 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\1") == Just "\1"
prop_getLiteralString12 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\12") == Just "\o12"
prop_getLiteralString13 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\123") == Just "\o123"
-- Maybe get the literal value of a token, using a custom function
-- to map unrecognized Tokens into strings.
getLiteralStringExt :: Monad m => (Token -> m String) -> Token -> m String
getLiteralStringExt more = g
where
allInList = fmap concat . mapM g
g (T_DoubleQuoted _ l) = allInList l
g (T_DollarDoubleQuoted _ l) = allInList l
g (T_NormalWord _ l) = allInList l
g (TA_Expansion _ l) = allInList l
g (T_SingleQuoted _ s) = return s
g (T_Literal _ s) = return s
g (T_ParamSubSpecialChar _ s) = return s
g (T_DollarSingleQuoted _ s) = return $ decodeEscapes s
g x = more x
-- Bash style $'..' decoding
decodeEscapes ('\\':c:cs) =
case c of
'a' -> '\a' : rest
'b' -> '\b' : rest
'e' -> '\x1B' : rest
'f' -> '\f' : rest
'n' -> '\n' : rest
'r' -> '\r' : rest
't' -> '\t' : rest
'v' -> '\v' : rest
'\'' -> '\'' : rest
'"' -> '"' : rest
'\\' -> '\\' : rest
'x' ->
case cs of
(x:y:more) | isHexDigit x && isHexDigit y ->
chr (16*(digitToInt x) + (digitToInt y)) : decodeEscapes more
(x:more) | isHexDigit x ->
chr (digitToInt x) : decodeEscapes more
more -> '\\' : 'x' : decodeEscapes more
_ | isOctDigit c ->
let (digits, more) = spanMax isOctDigit 3 (c:cs)
num = (parseOct digits) `mod` 256
in (chr num) : decodeEscapes more
_ -> '\\' : c : rest
where
rest = decodeEscapes cs
parseOct = f 0
where
f n "" = n
f n (c:rest) = f (n * 8 + digitToInt c) rest
spanMax f n list =
let (first, second) = span f list
(prefix, suffix) = splitAt n first
in
(prefix, suffix ++ second)
decodeEscapes (c:cs) = c : decodeEscapes cs
decodeEscapes [] = []
-- Is this token a string literal?
isLiteral t = isJust $ getLiteralString t
-- Is this token a string literal number?
isLiteralNumber t = fromMaybe False $ do
s <- getLiteralString t
guard $ all isDigit s
return True
-- Escape user data for messages.
-- Messages generally avoid repeating user data, but sometimes it's helpful.
e4m = escapeForMessage
escapeForMessage :: String -> String
escapeForMessage str = concatMap f str
where
f '\\' = "\\\\"
f '\n' = "\\n"
f '\r' = "\\r"
f '\t' = "\\t"
f '\x1B' = "\\e"
f c =
if shouldEscape c
then
if ord c < 256
then "\\x" ++ (pad0 2 $ toHex c)
else "\\U" ++ (pad0 4 $ toHex c)
else [c]
shouldEscape c =
(not $ isPrint c)
|| (not (isAscii c) && not (isLetter c))
pad0 :: Int -> String -> String
pad0 n s =
let l = length s in
if l < n
then (replicate (n-l) '0') ++ s
else s
toHex :: Char -> String
toHex c = map toUpper $ showHex (ord c) ""
-- Turn a NormalWord like foo="bar $baz" into a series of constituent elements like [foo=,bar ,$baz]
getWordParts (T_NormalWord _ l) = concatMap getWordParts l
getWordParts (T_DoubleQuoted _ l) = l
-- TA_Expansion is basically T_NormalWord for arithmetic expressions
getWordParts (TA_Expansion _ l) = concatMap getWordParts l
getWordParts other = [other]
-- Return a list of NormalWords that would result from brace expansion
braceExpand (T_NormalWord id list) = take 1000 $ do
items <- mapM part list
return $ T_NormalWord id items
where
part (T_BraceExpansion id items) = do
item <- items
braceExpand item
part x = return x
-- Maybe get a SimpleCommand from immediate wrappers like T_Redirections
getCommand t =
case t of
T_Redirecting _ _ w -> getCommand w
T_SimpleCommand _ _ (w:_) -> return t
T_Annotation _ _ t -> getCommand t
_ -> Nothing
-- Maybe get the command name string of a token representing a command
getCommandName :: Token -> Maybe String
getCommandName = fst . getCommandNameAndToken False
-- Maybe get the name+arguments of a command.
getCommandArgv t = do
(T_SimpleCommand _ _ args@(_:_)) <- getCommand t
return args
-- Get the command name token from a command, i.e.
-- the token representing 'ls' in 'ls -la 2> foo'.
-- If it can't be determined, return the original token.
getCommandTokenOrThis = snd . getCommandNameAndToken False
-- Given a command, get the string and token that represents the command name.
-- If direct, return the actual command (e.g. exec in 'exec ls')
-- If not, return the logical command (e.g. 'ls' in 'exec ls')
getCommandNameAndToken :: Bool -> Token -> (Maybe String, Token)
getCommandNameAndToken direct t = fromMaybe (Nothing, t) $ do
cmd@(T_SimpleCommand _ _ (w:rest)) <- getCommand t
s <- getLiteralString w
return $ fromMaybe (Just s, w) $ do
guard $ not direct
actual <- getEffectiveCommandToken s cmd rest
return (getLiteralString actual, actual)
where
getEffectiveCommandToken str cmd args =
let
firstArg = do
arg <- listToMaybe args
guard . not $ isFlag arg
return arg
in
case str of
"busybox" -> firstArg
"builtin" -> firstArg
"command" -> firstArg
"run" -> firstArg -- Used by bats
"exec" -> do
opts <- getBsdOpts "cla:" args
(_, (t, _)) <- find (null . fst) opts
return t
_ -> fail ""
-- If a command substitution is a single command, get its name.
-- $(date +%s) = Just "date"
getCommandNameFromExpansion :: Token -> Maybe String
getCommandNameFromExpansion t =
case t of
T_DollarExpansion _ [c] -> extract c
T_Backticked _ [c] -> extract c
T_DollarBraceCommandExpansion _ _ [c] -> extract c
_ -> Nothing
where
extract (T_Pipeline _ _ [cmd]) = getCommandName cmd
extract _ = Nothing
-- Get the basename of a token representing a command
getCommandBasename = fmap basename . getCommandName
basename = reverse . takeWhile (/= '/') . reverse
isAssignment t =
case t of
T_Redirecting _ _ w -> isAssignment w
T_SimpleCommand _ (w:_) [] -> True
T_Assignment {} -> True
T_Annotation _ _ w -> isAssignment w
_ -> False
isOnlyRedirection t =
case t of
T_Pipeline _ _ [x] -> isOnlyRedirection x
T_Annotation _ _ w -> isOnlyRedirection w
T_Redirecting _ (_:_) c -> isOnlyRedirection c
T_SimpleCommand _ [] [] -> True
_ -> False
isFunction t = case t of T_Function {} -> True; _ -> False
-- Bats tests are functions for the purpose of 'local' and such
isFunctionLike t =
case t of
T_Function {} -> True
T_BatsTest {} -> True
_ -> False
isBraceExpansion t = case t of T_BraceExpansion {} -> True; _ -> False
-- Get the lists of commands from tokens that contain them, such as
-- the conditions and bodies of while loops or branches of if statements.
getCommandSequences :: Token -> [[Token]]
getCommandSequences t =
case t of
T_Script _ _ cmds -> [cmds]
T_BraceGroup _ cmds -> [cmds]
T_Subshell _ cmds -> [cmds]
T_WhileExpression _ cond cmds -> [cond, cmds]
T_UntilExpression _ cond cmds -> [cond, cmds]
T_ForIn _ _ _ cmds -> [cmds]
T_ForArithmetic _ _ _ _ cmds -> [cmds]
T_IfExpression _ thens elses -> (concatMap (\(a,b) -> [a,b]) thens) ++ [elses]
T_Annotation _ _ t -> getCommandSequences t
T_DollarExpansion _ cmds -> [cmds]
T_DollarBraceCommandExpansion _ _ cmds -> [cmds]
T_Backticked _ cmds -> [cmds]
_ -> []
-- Get a list of names of associative arrays
getAssociativeArrays t =
nub . execWriter $ doAnalysis f t
where
f :: Token -> Writer [String] ()
f t@T_SimpleCommand {} = sequence_ $ do
name <- getCommandName t
let assocNames = ["declare","local","typeset"]
guard $ name `elem` assocNames
let flags = getAllFlags t
guard $ "A" `elem` map snd flags
let args = [arg | (arg, "") <- flags]
let names = mapMaybe (getLiteralStringExt nameAssignments) args
return $ tell names
f _ = return ()
nameAssignments t =
case t of
T_Assignment _ _ name _ _ -> return name
_ -> Nothing
-- A Pseudoglob is a wildcard pattern used for checking if a match can succeed.
-- For example, [[ $(cmd).jpg == [a-z] ]] will give the patterns *.jpg and ?, which
-- can be proven never to match.
data PseudoGlob = PGAny | PGMany | PGChar Char
deriving (Eq, Show)
-- Turn a word into a PG pattern, replacing all unknown/runtime values with
-- PGMany.
wordToPseudoGlob :: Token -> [PseudoGlob]
wordToPseudoGlob = fromMaybe [PGMany] . wordToPseudoGlob' False
-- Turn a word into a PG pattern, but only if we can preserve
-- exact semantics.
wordToExactPseudoGlob :: Token -> Maybe [PseudoGlob]
wordToExactPseudoGlob = wordToPseudoGlob' True
wordToPseudoGlob' :: Bool -> Token -> Maybe [PseudoGlob]
wordToPseudoGlob' exact word =
simplifyPseudoGlob <$> toGlob word
where
toGlob :: Token -> Maybe [PseudoGlob]
toGlob word =
case word of
T_NormalWord _ (T_Literal _ ('~':str):rest) -> do
guard $ not exact
let this = (PGMany : (map PGChar $ dropWhile (/= '/') str))
tail <- concat <$> (mapM f $ concatMap getWordParts rest)
return $ this ++ tail
_ -> concat <$> (mapM f $ getWordParts word)
f x = case x of
T_Literal _ s -> return $ map PGChar s
T_SingleQuoted _ s -> return $ map PGChar s
T_Glob _ "?" -> return [PGAny]
T_Glob _ "*" -> return [PGMany]
T_Glob _ ('[':_) | not exact -> return [PGAny]
_ -> if exact then fail "" else return [PGMany]
-- Reorder a PseudoGlob for more efficient matching, e.g.
-- f?*?**g -> f??*g
simplifyPseudoGlob :: [PseudoGlob] -> [PseudoGlob]
simplifyPseudoGlob = f
where
f [] = []
f (x@(PGChar _) : rest ) = x : f rest
f list =
let (anys, rest) = span (\x -> x == PGMany || x == PGAny) list in
order anys ++ f rest
order s = let (any, many) = partition (== PGAny) s in
any ++ take 1 many
-- Check whether the two patterns can ever overlap.
pseudoGlobsCanOverlap :: [PseudoGlob] -> [PseudoGlob] -> Bool
pseudoGlobsCanOverlap = matchable
where
matchable x@(xf:xs) y@(yf:ys) =
case (xf, yf) of
(PGMany, _) -> matchable x ys || matchable xs y
(_, PGMany) -> matchable x ys || matchable xs y
(PGAny, _) -> matchable xs ys
(_, PGAny) -> matchable xs ys
(_, _) -> xf == yf && matchable xs ys
matchable [] [] = True
matchable (PGMany : rest) [] = matchable rest []
matchable (_:_) [] = False
matchable [] r = matchable r []
-- Check whether the first pattern always overlaps the second.
pseudoGlobIsSuperSetof :: [PseudoGlob] -> [PseudoGlob] -> Bool
pseudoGlobIsSuperSetof = matchable
where
matchable x@(xf:xs) y@(yf:ys) =
case (xf, yf) of
(PGMany, PGMany) -> matchable x ys
(PGMany, _) -> matchable x ys || matchable xs y
(_, PGMany) -> False
(PGAny, _) -> matchable xs ys
(_, PGAny) -> False
(_, _) -> xf == yf && matchable xs ys
matchable [] [] = True
matchable (PGMany : rest) [] = matchable rest []
matchable _ _ = False
wordsCanBeEqual x y = pseudoGlobsCanOverlap (wordToPseudoGlob x) (wordToPseudoGlob y)
-- Is this an expansion that can be quoted,
-- e.g. $(foo) `foo` $foo (but not {foo,})?
isQuoteableExpansion t = case t of
T_DollarBraced {} -> True
_ -> isCommandSubstitution t
isCommandSubstitution t = case t of
T_DollarExpansion {} -> True
T_DollarBraceCommandExpansion {} -> True
T_Backticked {} -> True
_ -> False
-- Is this an expansion that results in a simple string?
isStringExpansion t = isCommandSubstitution t || case t of
T_DollarArithmetic {} -> True
T_DollarBraced {} -> not (isArrayExpansion t)
_ -> False
-- Is this a T_Annotation that ignores a specific code?
isAnnotationIgnoringCode code t =
case t of
T_Annotation _ anns _ -> any hasNum anns
_ -> False
where
hasNum (DisableComment from to) = code >= from && code < to
hasNum _ = False
prop_executableFromShebang1 = executableFromShebang "/bin/sh" == "sh"
prop_executableFromShebang2 = executableFromShebang "/bin/bash" == "bash"
prop_executableFromShebang3 = executableFromShebang "/usr/bin/env ksh" == "ksh"
prop_executableFromShebang4 = executableFromShebang "/usr/bin/env -S foo=bar bash -x" == "bash"
prop_executableFromShebang5 = executableFromShebang "/usr/bin/env --split-string=bash -x" == "bash"
prop_executableFromShebang6 = executableFromShebang "/usr/bin/env --split-string=foo=bar bash -x" == "bash"
prop_executableFromShebang7 = executableFromShebang "/usr/bin/env --split-string bash -x" == "bash"
prop_executableFromShebang8 = executableFromShebang "/usr/bin/env --split-string foo=bar bash -x" == "bash"
prop_executableFromShebang9 = executableFromShebang "/usr/bin/env foo=bar dash" == "dash"
prop_executableFromShebang10 = executableFromShebang "/bin/busybox sh" == "busybox sh"
prop_executableFromShebang11 = executableFromShebang "/bin/busybox ash" == "busybox ash"
-- Get the shell executable from a string like '/usr/bin/env bash'
executableFromShebang :: String -> String
executableFromShebang = shellFor
where
re = mkRegex "/env +(-S|--split-string=?)? *(.*)"
shellFor s | s `matches` re =
case matchRegex re s of
Just [flag, shell] -> fromEnvArgs (words shell)
_ -> ""
shellFor sb =
case words sb of
[] -> ""
[x] -> basename x
(first:second:args) | basename first == "busybox" ->
case basename second of
"sh" -> "busybox sh"
"ash" -> "busybox ash"
x -> x
(first:args) | basename first == "env" ->
fromEnvArgs args
(first:_) -> basename first
fromEnvArgs args = fromMaybe "" $ find (notElem '=') $ skipFlags args
basename s = reverse . takeWhile (/= '/') . reverse $ s
skipFlags = dropWhile ("-" `isPrefixOf`)
-- Determining if a name is a variable
isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x
isVariableChar x = isVariableStartChar x || isDigit x
isSpecialVariableChar = (`elem` "*@#?-$!")
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
-- 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_getBracedReference11b = 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) | c `elem` "!#" = rest
dropPrefix cs = cs
takeName s = do
let name = takeWhile isVariableChar s
guard . not $ null name
return name
getSpecial (c:_) | isSpecialVariableChar c = return [c]
getSpecial _ = fail "empty or not special"
nameExpansion ('!':next:rest) = do -- e.g. ${!foo*bar*}
guard $ isVariableChar next -- e.g. ${!@}
first <- find (not . isVariableChar) rest
guard $ first `elem` "*?@"
return ""
nameExpansion _ = Nothing
-- Get the variable modifier like /a/b in ${var/a/b}
prop_getBracedModifier1 = getBracedModifier "foo:bar:baz" == ":bar:baz"
prop_getBracedModifier2 = getBracedModifier "!var:-foo" == ":-foo"
prop_getBracedModifier3 = getBracedModifier "foo[bar]" == "[bar]"
prop_getBracedModifier4 = getBracedModifier "foo[@]@Q" == "[@]@Q"
prop_getBracedModifier5 = getBracedModifier "@@Q" == "@Q"
getBracedModifier s = headOrDefault "" $ 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]
-- Get the variables from indices like ["x", "y"] in ${var[x+y+1]}
prop_getIndexReferences1 = getIndexReferences "var[x+y+1]" == ["x", "y"]
getIndexReferences s = fromMaybe [] $ do
index:_ <- matchRegex re s
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 ]
_:offsets:_ <- matchRegex re mods
return $ matchAllStrings variableNameRegex offsets
where
re = mkRegex "^(\\[.+\\])? *:([^-=?+].*)"
-- Returns whether a token is a parameter expansion without any modifiers.
-- True for $var ${var} $1 $#
-- False for ${#var} ${var[x]} ${var:-0}
isUnmodifiedParameterExpansion t =
case t of
T_DollarBraced _ False _ -> True
T_DollarBraced _ _ list ->
let str = concat $ oversimplify list
in getBracedReference str == str
_ -> False
-- Return the referenced variable if (and only if) it's an unmodified parameter expansion.
getUnmodifiedParameterExpansion t =
case t of
T_DollarBraced _ _ list -> do
let str = concat $ oversimplify list
guard $ getBracedReference str == str
return str
_ -> Nothing
--- A list of the element and all its parents up to the root node.
getPath tree = NE.unfoldr $ \t -> (t, Map.lookup (getId t) tree)
isClosingFileOp op =
case op of
T_IoDuplicate _ (T_GREATAND _) "-" -> True
T_IoDuplicate _ (T_LESSAND _) "-" -> True
_ -> False
getEnableDirectives root =
case root of
T_Annotation _ list _ -> [s | EnableComment s <- list]
_ -> []
getExtendedAnalysisDirective :: Token -> Maybe Bool
getExtendedAnalysisDirective root =
case root of
T_Annotation _ list _ -> listToMaybe $ [s | ExtendedAnalysis s <- list]
_ -> Nothing
return []
runTests = $quickCheckAll