diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 0052ef5..a09bf38 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -30,6 +30,8 @@ import Data.List import Data.Maybe import qualified Data.Map as Map +arguments (T_SimpleCommand _ _ (cmd:args)) = args + -- Is this a type of loop? isLoop t = case t of T_WhileExpression {} -> True @@ -135,32 +137,91 @@ isUnquotedFlag token = fromMaybe False $ do str <- getLeadingUnquotedString token return $ "-" `isPrefixOf` str --- getGnuOpts "erd:u:" will parse a SimpleCommand like --- read -re -d : -u 3 bar +-- getGnuOpts "erd:u:" will parse a list of arguments tokens like `read` +-- -re -d : -u 3 bar -- into --- Just [("r", -re), ("e", -re), ("d", :), ("u", 3), ("", bar)] --- where flags with arguments map to arguments, while others map to themselves. --- Any unrecognized flag will result in Nothing. -getGnuOpts str t = getOpts str $ getAllFlags t -getBsdOpts str t = getOpts str $ getLeadingFlags t -getOpts :: String -> [(Token, String)] -> Maybe [(String, Token)] -getOpts string flags = process flags +-- 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 [] = [] + flagList [] = longopts flagMap = Map.fromList $ ("", False) : flagList string process [] = return [] - process ((token1, flag):rest1) = do - takesArg <- Map.lookup flag flagMap - (token, rest) <- if takesArg - then case rest1 of - (token2, ""):rest2 -> return (token2, rest2) - _ -> fail "takesArg without valid arg" - else return (token1, rest1) - more <- process rest - return $ (flag, token) : more + 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) = @@ -362,8 +423,8 @@ getCommandNameAndToken direct t = fromMaybe (Nothing, t) $ do "builtin" -> firstArg "command" -> firstArg "exec" -> do - opts <- getBsdOpts "cla:" cmd - (_, t) <- listToMaybe $ filter (null . fst) opts + opts <- getBsdOpts "cla:" args + (_, (t, _)) <- listToMaybe $ filter (null . fst) opts return t _ -> fail "" diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e5287f8..cf7bcb1 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -2925,8 +2925,8 @@ checkReadWithoutR _ t@T_SimpleCommand {} | t `isUnqualifiedCommand` "read" where flags = getAllFlags t has_t0 = Just "0" == do - parsed <- getOpts flagsForRead flags - t <- lookup "t" parsed + parsed <- getGnuOpts flagsForRead $ arguments t + (_, t) <- lookup "t" parsed getLiteralString t checkReadWithoutR _ _ = return () @@ -3383,7 +3383,7 @@ checkPipeToNowhere params t = commandSpecificException name cmd = case name of - "du" -> any (`elem` ["exclude-from", "files0-from"]) $ lt $ map snd $ getAllFlags cmd + "du" -> any (`elem` ["exclude-from", "files0-from"]) $ map snd $ getAllFlags cmd _ -> False warnAboutDupes (n, list@(_:_:_)) = diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 724857c..0f40b3b 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -678,13 +678,13 @@ getModifiedVariableCommand base@(T_SimpleCommand id cmdPrefix (T_NormalWord _ (T where parseArgs :: Maybe (Token, Token, String, DataType) parseArgs = do - args <- getGnuOpts "d:n:O:s:u:C:c:t" base + args <- getGnuOpts "d:n:O:s:u:C:c:t" rest let names = map snd $ filter (\(x,y) -> null x) args if null names then return (base, base, "MAPFILE", DataArray SourceExternal) else do - first <- listToMaybe names + (_, first) <- listToMaybe names name <- getLiteralString first guard $ isVariableName name return (base, first, name, DataArray SourceExternal) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index b4e8b3e..9af7748 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -53,8 +53,6 @@ verify :: CommandCheck -> String -> Bool verify f s = producesComments (getChecker [f]) s == Just True verifyNot f s = producesComments (getChecker [f]) s == Just False -arguments (T_SimpleCommand _ _ (cmd:args)) = args - commandChecks :: [CommandCheck] commandChecks = [ checkTr @@ -116,6 +114,35 @@ prop_verifyOptionalExamples = all check optionalCommandChecks verify check (cdPositive desc) && verifyNot check (cdNegative desc) +-- Run a check against the getopt parser. If it fails, the lists are empty. +checkGetOpts str flags args f = + flags == actualFlags && args == actualArgs + where + toTokens = map (T_Literal (Id 0)) . words + opts = fromMaybe [] $ f (toTokens str) + actualFlags = filter (not . null) $ map fst opts + actualArgs = map (\(_, (_, x)) -> onlyLiteralString x) $ filter (null . fst) opts + +-- Short options +prop_checkGetOptsS1 = checkGetOpts "-f x" ["f"] [] $ getOpts (True, True) "f:" [] +prop_checkGetOptsS2 = checkGetOpts "-fx" ["f"] [] $ getOpts (True, True) "f:" [] +prop_checkGetOptsS3 = checkGetOpts "-f -x" ["f", "x"] [] $ getOpts (True, True) "fx" [] +prop_checkGetOptsS4 = checkGetOpts "-f -x" ["f"] [] $ getOpts (True, True) "f:" [] +prop_checkGetOptsS5 = checkGetOpts "-fx" [] [] $ getOpts (True, True) "fx:" [] + +-- Long options +prop_checkGetOptsL1 = checkGetOpts "--foo=bar baz" ["foo"] ["baz"] $ getOpts (True, False) "" [("foo", True)] +prop_checkGetOptsL2 = checkGetOpts "--foo bar baz" ["foo"] ["baz"] $ getOpts (True, False) "" [("foo", True)] +prop_checkGetOptsL3 = checkGetOpts "--foo baz" ["foo"] ["baz"] $ getOpts (True, True) "" [] +prop_checkGetOptsL4 = checkGetOpts "--foo baz" [] [] $ getOpts (True, False) "" [] + +-- Know when to terminate +prop_checkGetOptsT1 = checkGetOpts "-a x -b" ["a", "b"] ["x"] $ getOpts (True, True) "ab" [] +prop_checkGetOptsT2 = checkGetOpts "-a x -b" ["a"] ["x","-b"] $ getOpts (False, True) "ab" [] +prop_checkGetOptsT3 = checkGetOpts "-a -- -b" ["a"] ["-b"] $ getOpts (True, True) "ab" [] +prop_checkGetOptsT4 = checkGetOpts "-a -- -b" ["a", "b"] [] $ getOpts (True, True) "a:b" [] + + buildCommandMap :: [CommandCheck] -> Map.Map CommandName (Token -> Analysis) buildCommandMap = foldl' addCheck Map.empty where @@ -694,8 +721,8 @@ checkReadExpansions = CommandCheck (Exactly "read") check where options = getGnuOpts flagsForRead getVars cmd = fromMaybe [] $ do - opts <- options cmd - return [y | (x,y) <- opts, null x || x == "a"] + opts <- options $ arguments cmd + return [y | (x,(_, y)) <- opts, null x || x == "a"] check cmd = mapM_ warning $ getVars cmd warning t = sequence_ $ do @@ -1070,8 +1097,8 @@ prop_checkSudoArgs7 = verifyNot checkSudoArgs "sudo docker export foo" checkSudoArgs = CommandCheck (Basename "sudo") f where f t = sequence_ $ do - opts <- parseOpts t - let nonFlags = [x | ("",x) <- opts] + opts <- parseOpts $ arguments t + let nonFlags = [x | ("",(x, _)) <- opts] commandArg <- nonFlags !!! 0 command <- getLiteralString commandArg guard $ command `elem` builtins