From 84945091507a3353785cedf63841d2112d9ddef1 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 9 Aug 2014 17:32:42 -0700 Subject: [PATCH] Warn about missing shebangs. --- README.md | 2 +- ShellCheck.cabal | 1 + ShellCheck/Analytics.hs | 60 ++++++++++++++++---------------- ShellCheck/Options.hs | 14 ++++++++ ShellCheck/Parser.hs | 7 ++-- ShellCheck/Simple.hs | 29 +++++++++------- shellcheck.1.md | 16 +++++---- shellcheck.hs | 76 +++++++++++++++++++++++------------------ 8 files changed, 117 insertions(+), 88 deletions(-) create mode 100644 ShellCheck/Options.hs diff --git a/README.md b/README.md index 0122831..48e3fa2 100644 --- a/README.md +++ b/README.md @@ -16,7 +16,7 @@ The goals of ShellCheck are: - To point out subtle caveats, corner cases and pitfalls, that may cause an advanced user's otherwise working script to fail under future circumstances. -ShellCheck is written in Haskell, and requires at least 1 GB of RAM to compile. +ShellCheck is written in Haskell, and requires 2 GB of memory to compile. ## Installing diff --git a/ShellCheck.cabal b/ShellCheck.cabal index 12ed9f0..700587f 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -47,6 +47,7 @@ library ShellCheck.Analytics ShellCheck.AST ShellCheck.Data + ShellCheck.Options ShellCheck.Parser ShellCheck.Simple other-modules: diff --git a/ShellCheck/Analytics.hs b/ShellCheck/Analytics.hs index aa4c88c..f310b94 100644 --- a/ShellCheck/Analytics.hs +++ b/ShellCheck/Analytics.hs @@ -16,7 +16,7 @@ along with this program. If not, see . -} {-# LANGUAGE TemplateHaskell #-} -module ShellCheck.Analytics (AnalysisOption(..), filterByAnnotation, runAnalytics, shellForExecutable, runTests) where +module ShellCheck.Analytics (AnalysisOptions(..), defaultAnalysisOptions, filterByAnnotation, runAnalytics, shellForExecutable, runTests) where import Control.Arrow (first) import Control.Monad @@ -29,23 +29,19 @@ import Data.List import Data.Maybe import Debug.Trace import ShellCheck.AST +import ShellCheck.Options import ShellCheck.Data import ShellCheck.Parser hiding (runTests) import Text.Regex import qualified Data.Map as Map import Test.QuickCheck.All (quickCheckAll) -data Shell = Ksh | Zsh | Sh | Bash - deriving (Show, Eq) - data Parameters = Parameters { variableFlow :: [StackData], parentMap :: Map.Map Id Token, shellType :: Shell } -data AnalysisOption = ForceShell Shell - -- Checks that are run on the AST root treeChecks :: [Parameters -> Token -> [Note]] treeChecks = [ @@ -55,11 +51,12 @@ treeChecks = [ ,subshellAssignmentCheck ,checkSpacefulness ,checkQuotesInLiterals - ,checkShebang + ,checkShebangParameters ,checkFunctionsUsedExternally ,checkUnusedAssignments ,checkUnpassedInFunctions ,checkArrayWithoutIndex + ,checkShebang ] checksFor Sh = [ @@ -81,24 +78,19 @@ checksFor Bash = [ ,checkForDecimals ] -runAnalytics :: [AnalysisOption] -> Token -> [Note] +runAnalytics :: AnalysisOptions -> Token -> [Note] runAnalytics options root = runList options root treeChecks runList options root list = notes where params = Parameters { - shellType = getShellOption, + shellType = fromMaybe (determineShell root) $ optionShellType options, parentMap = getParentTree root, variableFlow = getVariableFlow (shellType params) (parentMap params) root } - notes = concatMap (\f -> f params root) list + notes = filter (\c -> getCode c `notElem` optionExcludes options) $ concatMap (\f -> f params root) list + getCode (Note _ _ c _) = c - getShellOption = - fromMaybe (determineShell root) . msum $ - map (\option -> - case option of - ForceShell x -> return x - ) options checkList l t = concatMap (\f -> f t) l @@ -353,21 +345,21 @@ getFlags _ = [] [] -> Nothing (r:_) -> Just r -verify :: (Parameters -> Token -> Writer [a] ()) -> String -> Bool +verify :: (Parameters -> Token -> Writer [Note] ()) -> String -> Bool verify f s = checkNode f s == Just True -verifyNot :: (Parameters -> Token -> Writer [a] ()) -> String -> Bool +verifyNot :: (Parameters -> Token -> Writer [Note] ()) -> String -> Bool verifyNot f s = checkNode f s == Just False -verifyTree :: (Parameters -> Token -> [a]) -> String -> Bool +verifyTree :: (Parameters -> Token -> [Note]) -> String -> Bool verifyTree f s = checkTree f s == Just True -verifyNotTree :: (Parameters -> Token -> [a]) -> String -> Bool +verifyNotTree :: (Parameters -> Token -> [Note]) -> String -> Bool verifyNotTree f s = checkTree f s == Just False checkNode f = checkTree (runNodeAnalysis f) checkTree f s = case parseShell "-" s of - (ParseResult (Just (t, m)) _) -> Just . not . null $ runList [] t [f] + (ParseResult (Just (t, m)) _) -> Just . not . null $ runList defaultAnalysisOptions t [f] _ -> Nothing @@ -504,7 +496,7 @@ checkPipePitfalls _ (T_Pipeline id _ commands) = do \(find:xargs:_) -> let args = deadSimple xargs ++ deadSimple find in - unless (or $ map ($ args) [ + unless (any ($ args) [ hasShortParameter '0', hasParameter "null", hasParameter "print0", @@ -541,9 +533,9 @@ checkPipePitfalls _ (T_Pipeline id _ commands) = do for' l f = for l (first f) first func (x:_) = func (getId x) first _ _ = return () - hasShortParameter char list = any (\x -> "-" `isPrefixOf` x && char `elem` x) list - hasParameter string list = - any (isPrefixOf string . dropWhile (== '-')) list + hasShortParameter char = any (\x -> "-" `isPrefixOf` x && char `elem` x) + hasParameter string = + any (isPrefixOf string . dropWhile (== '-')) checkPipePitfalls _ _ = return () indexOfSublists sub = f 0 @@ -593,11 +585,17 @@ mayBecomeMultipleArgs t = willBecomeMultipleArgs t || f t f (T_NormalWord _ parts) = any f parts f _ = False -prop_checkShebang1 = verifyTree checkShebang "#!/usr/bin/env bash -x\necho cow" -prop_checkShebang2 = verifyNotTree checkShebang "#! /bin/sh -l " -checkShebang _ (T_Script id sb _) = +prop_checkShebangParameters1 = verifyTree checkShebangParameters "#!/usr/bin/env bash -x\necho cow" +prop_checkShebangParameters2 = verifyNotTree checkShebangParameters "#! /bin/sh -l " +checkShebangParameters _ (T_Script id sb _) = [Note id ErrorC 2096 "On most OS, shebangs can only specify a single parameter." | length (words sb) > 2] +prop_checkShebang1 = verifyNotTree checkShebang "#!/usr/bin/env bash -x\necho cow" +prop_checkShebang2 = verifyNotTree checkShebang "#! /bin/sh -l " +prop_checkShebang3 = verifyTree checkShebang "ls -l" +checkShebang params (T_Script id sb _) = + [Note id ErrorC 2148 "Include a shebang (#!) to specify the shell." | sb == ""] + prop_checkBashisms = verify checkBashisms "while read a; do :; done < <(a)" prop_checkBashisms2 = verify checkBashisms "[ foo -nt bar ]" prop_checkBashisms3 = verify checkBashisms "echo $((i++))" @@ -618,8 +616,8 @@ prop_checkBashisms17= verify checkBashisms "echo $((RANDOM%6+1))" prop_checkBashisms18= verify checkBashisms "foo &> /dev/null" checkBashisms _ = bashism where - errMsg id s = err id 2040 $ "#!/bin/sh was specified, so " ++ s ++ " not supported, even when sh is actually bash." - warnMsg id s = warn id 2039 $ "#!/bin/sh was specified, but " ++ s ++ " not standard." + errMsg id s = err id 2040 $ "In sh, " ++ s ++ " not supported, even when sh is actually bash." + warnMsg id s = warn id 2039 $ "In POSIX sh, " ++ s ++ " not supported." bashism (T_ProcSub id _ _) = errMsg id "process substitution is" bashism (T_Extglob id _ _) = warnMsg id "extglob is" bashism (T_DollarSingleQuoted id _) = warnMsg id "$'..' is" @@ -1412,7 +1410,7 @@ getWordParts (T_NormalWord _ l) = concatMap getWordParts l getWordParts (T_DoubleQuoted _ l) = l getWordParts other = [other] -isCommand token str = isCommandMatch token (\cmd -> cmd == str || ("/" ++ str) `isSuffixOf` cmd) +isCommand token str = isCommandMatch token (\cmd -> cmd == str || ('/' : str) `isSuffixOf` cmd) isUnqualifiedCommand token str = isCommandMatch token (== str) isCommandMatch token matcher = fromMaybe False $ do diff --git a/ShellCheck/Options.hs b/ShellCheck/Options.hs new file mode 100644 index 0000000..d1a044c --- /dev/null +++ b/ShellCheck/Options.hs @@ -0,0 +1,14 @@ +module ShellCheck.Options where + +data Shell = Ksh | Zsh | Sh | Bash + deriving (Show, Eq) + +data AnalysisOptions = AnalysisOptions { + optionShellType :: Maybe Shell, + optionExcludes :: [Integer] +} + +defaultAnalysisOptions = AnalysisOptions { + optionShellType = Nothing, + optionExcludes = [] +} diff --git a/ShellCheck/Parser.hs b/ShellCheck/Parser.hs index 25abbf7..b0a021e 100644 --- a/ShellCheck/Parser.hs +++ b/ShellCheck/Parser.hs @@ -1801,8 +1801,7 @@ readLetSuffix = many1 (readIoRedirect <|> try readLetExpression <|> readCmdWord) -- Get whatever a parser would parse as a string readStringForParser parser = do pos <- lookAhead (parser >> getPosition) - s <- readUntil pos - return s + readUntil pos where readUntil endPos = anyChar `reluctantlyTill` (getPosition >>= guard . (== endPos)) @@ -1995,11 +1994,11 @@ readScript = do return $ T_Script id sb commands; } <|> do { parseProblem WarningC 1014 "Couldn't read any commands."; - return $ T_Script id sb [T_EOF id]; + return $ T_Script id sb [] } else do many anyChar - return $ T_Script id sb [T_EOF id]; + return $ T_Script id sb []; where basename s = reverse . takeWhile (/= '/') . reverse $ s diff --git a/ShellCheck/Simple.hs b/ShellCheck/Simple.hs index bd1aa03..4eef476 100644 --- a/ShellCheck/Simple.hs +++ b/ShellCheck/Simple.hs @@ -18,15 +18,16 @@ {-# LANGUAGE TemplateHaskell #-} module ShellCheck.Simple (shellCheck, ShellCheckComment, scLine, scColumn, scSeverity, scCode, scMessage, runTests) where -import ShellCheck.Parser hiding (runTests) -import ShellCheck.Analytics hiding (runTests) -import Data.Maybe -import Text.Parsec.Pos import Data.List +import Data.Maybe +import ShellCheck.Analytics hiding (runTests) +import ShellCheck.Options +import ShellCheck.Parser hiding (runTests) import Test.QuickCheck.All (quickCheckAll) +import Text.Parsec.Pos -shellCheck :: String -> [AnalysisOption] -> [ShellCheckComment] -shellCheck script options = +shellCheck :: AnalysisOptions -> String -> [ShellCheckComment] +shellCheck options script = let (ParseResult result notes) = parseShell "-" script in let allNotes = notes ++ concat (maybeToList $ do (tree, posMap) <- result @@ -51,21 +52,25 @@ severityToString s = formatNote (ParseNote pos severity code text) = ShellCheckComment (sourceLine pos) (sourceColumn pos) (severityToString severity) (fromIntegral code) text +testCheck = shellCheck defaultAnalysisOptions { optionExcludes = [2148] } -- Ignore #! warnings prop_findsParseIssue = - let comments = shellCheck "echo \"$12\"" [] in + let comments = testCheck "echo \"$12\"" in length comments == 1 && scCode (head comments) == 1037 prop_commentDisablesParseIssue1 = - null $ shellCheck "#shellcheck disable=SC1037\necho \"$12\"" [] + null $ testCheck "#shellcheck disable=SC1037\necho \"$12\"" prop_commentDisablesParseIssue2 = - null $ shellCheck "#shellcheck disable=SC1037\n#lol\necho \"$12\"" [] + null $ testCheck "#shellcheck disable=SC1037\n#lol\necho \"$12\"" prop_findsAnalysisIssue = - let comments = shellCheck "echo $1" [] in + let comments = testCheck "echo $1" in length comments == 1 && scCode (head comments) == 2086 prop_commentDisablesAnalysisIssue1 = - null $ shellCheck "#shellcheck disable=SC2086\necho $1" [] + null $ testCheck "#shellcheck disable=SC2086\necho $1" prop_commentDisablesAnalysisIssue2 = - null $ shellCheck "#shellcheck disable=SC2086\n#lol\necho $1" [] + null $ testCheck "#shellcheck disable=SC2086\n#lol\necho $1" + +prop_optionDisablesIssue1 = + null $ shellCheck (defaultAnalysisOptions { optionExcludes = [2086, 2148] }) "echo $1" return [] runTests = $quickCheckAll diff --git a/shellcheck.1.md b/shellcheck.1.md index 91dcde3..7f40062 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -18,24 +18,28 @@ corner cases can cause delayed failures. # OPTIONS -**-f** *FORMAT*, **--format=***FORMAT* - -: Specify the output format of shellcheck, which prints its results in the - standard output. Subsequent **-f** options are ignored, see **FORMATS** - below for more information. - **-e**\ *CODE1*[,*CODE2*...],\ **--exclude=***CODE1*[,*CODE2*...] : Explicitly exclude the specified codes from the report. Subsequent **-e** options are cumulative, but all the codes can be specified at once, comma-separated as a single argument. +**-f** *FORMAT*, **--format=***FORMAT* + +: Specify the output format of shellcheck, which prints its results in the + standard output. Subsequent **-f** options are ignored, see **FORMATS** + below for more information. + **-s**\ *shell*,\ **--shell=***shell* : Specify Bourne shell dialect. Valid values are *sh*, *bash*, *ksh* and *zsh*. The default is to use the file's shebang, or *bash* if the target shell can't be determined. +**-V**\ *version*,\ **--version** + +: Print version and exit. + # FORMATS **tty** diff --git a/shellcheck.hs b/shellcheck.hs index d4f6d84..1f0b8c4 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -26,6 +26,7 @@ import GHC.Exts import GHC.IO.Device import Prelude hiding (catch) import ShellCheck.Data +import ShellCheck.Options import ShellCheck.Simple import ShellCheck.Analytics import System.Console.GetOpt @@ -48,10 +49,10 @@ instance Monoid Status where header = "Usage: shellcheck [OPTIONS...] FILES..." options = [ - Option "f" ["format"] - (ReqArg (Flag "format") "FORMAT") "output format", Option "e" ["exclude"] (ReqArg (Flag "exclude") "CODE1,CODE2..") "exclude types of warnings", + Option "f" ["format"] + (ReqArg (Flag "format") "FORMAT") "output format", Option "s" ["shell"] (ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (bash,sh,ksh,zsh)", Option "V" ["version"] @@ -74,15 +75,12 @@ instance JSON ShellCheckComment where parseArguments :: [String] -> ErrorT Status IO ([Flag], [FilePath]) parseArguments argv = case getOpt Permute options argv of - (opts, files, []) -> do - verifyOptions opts files - return (opts, files) - + (opts, files, []) -> return (opts, files) (_, _, errors) -> do liftIO . printErr $ concat errors ++ "\n" ++ usageInfo header options throwError SyntaxFailure -formats :: Map.Map String ([Flag] -> [FilePath] -> IO Status) +formats :: Map.Map String (AnalysisOptions -> [FilePath] -> IO Status) formats = Map.fromList [ ("json", forJson), ("gcc", forGcc), @@ -93,7 +91,7 @@ formats = Map.fromList [ toStatus = liftM (either id (const NoProblems)) . runErrorT catchExceptions :: IO Status -> IO Status -catchExceptions action = action `catch` handler +catchExceptions action = action -- action `catch` handler where handler err = do printErr $ show (err :: SomeException) @@ -101,7 +99,7 @@ catchExceptions action = action `catch` handler checkComments comments = if null comments then NoProblems else SomeProblems -forTty :: [Flag] -> [FilePath] -> IO Status +forTty :: AnalysisOptions -> [FilePath] -> IO Status forTty options files = do output <- mapM doFile files return $ mconcat output @@ -155,14 +153,14 @@ forTty options files = do return $ if term then colorComment else const id -- This totally ignores the filenames. Fixme? -forJson :: [Flag] -> [FilePath] -> IO Status +forJson :: AnalysisOptions -> [FilePath] -> IO Status forJson options files = catchExceptions $ do comments <- liftM concat $ mapM (commentsFor options) files putStrLn $ encodeStrict comments return $ checkComments comments -- Mimic GCC "file:line:col: (error|warning|note): message" format -forGcc :: [Flag] -> [FilePath] -> IO Status +forGcc :: AnalysisOptions -> [FilePath] -> IO Status forGcc options files = do files <- mapM process files return $ mconcat files @@ -187,7 +185,7 @@ forGcc options files = do ] -- Checkstyle compatible output. A bit of a hack to avoid XML dependencies -forCheckstyle :: [Flag] -> [FilePath] -> IO Status +forCheckstyle :: AnalysisOptions -> [FilePath] -> IO Status forCheckstyle options files = do putStrLn "" putStrLn "" @@ -226,23 +224,13 @@ forCheckstyle options files = do commentsFor options file = liftM (getComments options) $ readContents file -getComments options contents = - excludeCodes (getExclusions options) $ shellCheck contents analysisOptions - where - analysisOptions = catMaybes [ shellOption ] - shellOption = do - option <- getOption options "shell" - sh <- shellForExecutable option - return $ ForceShell sh - +getComments = shellCheck readContents :: FilePath -> IO String readContents file = if file == "-" then getContents else readFile file - where - force s = foldr (flip const) s s -- Realign comments from a tabstop of 8 to 1 makeNonVirtual comments contents = @@ -300,8 +288,10 @@ statusToCode status = RuntimeException -> ExitFailure 2 process :: [Flag] -> [FilePath] -> ErrorT Status IO () -process options files = - let format = fromMaybe "tty" $ getOption options "format" in +process flags files = do + options <- foldM (flip parseOption) defaultAnalysisOptions flags + verifyFiles files + let format = fromMaybe "tty" $ getOption flags "format" case Map.lookup format formats of Nothing -> do liftIO $ do @@ -312,17 +302,35 @@ process options files = where write s = " " ++ s Just f -> ErrorT $ liftM Left $ f options files -verifyOptions :: [Flag] -> [FilePath] -> ErrorT Status IO () -verifyOptions opts files = do - when (isJust $ getOption opts "version") $ do - liftIO printVersion - throwError NoProblems +parseOption flag options = + case flag of + Flag "shell" str -> + fromMaybe (die $ "Unknown shell: " ++ str) $ do + shell <- shellForExecutable str + return $ return options { optionShellType = Just shell } - let shell = getOption opts "shell" in - when (isJust shell && isNothing (shell >>= shellForExecutable)) $ do - liftIO $ printErr ("Unknown shell: " ++ fromJust shell) - throwError SupportFailure + Flag "exclude" str -> do + new <- mapM parseNum $ split ',' str + let old = optionExcludes options + return options { optionExcludes = new ++ old } + + Flag "version" _ -> do + liftIO printVersion + throwError NoProblems + + _ -> return options + where + die s = do + liftIO $ printErr s + throwError SupportFailure + parseNum ('S':'C':str) = parseNum str + parseNum num = do + unless (all isDigit num) $ do + liftIO . printErr $ "Bad exclusion: " ++ num + throwError SyntaxFailure + return (Prelude.read num :: Integer) +verifyFiles files = when (null files) $ do liftIO $ printErr "No files specified.\n" liftIO $ printErr $ usageInfo header options -- GitLab