| {- |
| Copyright 2012-2019 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.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.Map as Map |
| import Numeric (showHex) |
| |
| import Test.QuickCheck |
| |
| -- 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_Extglob {} = True |
| isGlob T_Glob {} = True |
| isGlob (T_NormalWord _ l) = any isGlob l |
| isGlob _ = 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 "Internal shellcheck error, please report! (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 = fromMaybe False $ do |
| str <- getLeadingUnquotedString token |
| return $ "-" `isPrefixOf` str |
| |
| -- 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))) |
| |
| -- 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 t |
| where |
| f (T_DollarBraced _ _ l) = |
| let string = concat $ oversimplify l in |
| "!" `isPrefixOf` string |
| f (T_DoubleQuoted _ parts) = any f parts |
| f (T_NormalWord _ parts) = any f 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_DoubleQuoted _ parts) = any f parts |
| 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 |
| |
| -- 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) -> |
| if isHexDigit x && isHexDigit y |
| then chr (16*(digitToInt x) + (digitToInt y)) : rest |
| else '\\':c:rest |
| _ | isOctDigit c -> |
| let digits = take 3 $ takeWhile isOctDigit (c:cs) |
| num = parseOct digits |
| in (if num < 256 then chr num else '?') : rest |
| _ -> '\\' : c : rest |
| where |
| rest = decodeEscapes cs |
| parseOct = f 0 |
| where |
| f n "" = n |
| f n (c:rest) = f (n * 8 + digitToInt c) rest |
| decodeEscapes (c:cs) = c : decodeEscapes cs |
| decodeEscapes [] = [] |
| |
| -- Is this token a string literal? |
| isLiteral t = isJust $ getLiteralString t |
| |
| -- 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 |
| |
| -- If a command substitution is a single command, get its argument Tokens. |
| -- Return an empty list if there are no arguments or the token is not a command substitution. |
| -- $(date +%s) = ["+%s"] |
| getArgumentsFromExpansion :: Token -> [Token] |
| getArgumentsFromExpansion t = |
| case t of |
| T_DollarExpansion _ [c] -> extract c |
| T_Backticked _ [c] -> extract c |
| T_DollarBraceCommandExpansion _ [c] -> extract c |
| _ -> [] |
| where |
| extract (T_Pipeline _ _ [cmd]) = arguments cmd |
| extract _ = [] |
| |
| -- Get the basename of a token representing a command |
| getCommandBasename = fmap basename . getCommandName |
| |
| basename = reverse . takeWhile (/= '/') . reverse |
| |
| -- Get the arguments to a command |
| arguments (T_SimpleCommand _ _ (cmd:args)) = args |
| arguments t = maybe [] arguments (getCommand t) |
| |
| 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" == "ash" |
| prop_executableFromShebang11 = executableFromShebang "/bin/busybox ash" == "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" -> "ash" -- busybox sh is 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`) |
| |
| return [] |
| runTests = $quickCheckAll |
