From af46758ff17dab17d23a1f30b92a0c470bc53f29 Mon Sep 17 00:00:00 2001 From: Pontus Andersson Date: Mon, 22 Apr 2019 14:34:38 +0200 Subject: [PATCH 1/2] Add option to look for sources in alternate root paths Add a new optional flag "-r|--root ROOTPATHS", where ROOTPATHS is a colon separated list of paths, that will look for external sources in alternate roots. This is particular useful when the run-time environment does not fully match the development environment. The #shellcheck source=file directive is useful, but has its limitations in certain scenarios. Also, in many cases the directive could be removed from scripts when the root flag is used. Script example.bash: #!/bin/bash source /etc/foo/config Example usage where etc/foo/config exists in skel/foo: # shellcheck -x -r skel/foo:skel/core example.bash --- shellcheck.hs | 30 ++++++++++++++++++++++++++++++ src/ShellCheck/Interface.hs | 4 ++++ src/ShellCheck/Parser.hs | 4 +++- 3 files changed, 37 insertions(+), 1 deletion(-) diff --git a/shellcheck.hs b/shellcheck.hs index 06516e5..c57c379 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -69,6 +69,7 @@ instance Monoid Status where data Options = Options { checkSpec :: CheckSpec, externalSources :: Bool, + rootPaths :: [FilePath], formatterOptions :: FormatterOptions, minSeverity :: Severity } @@ -76,6 +77,7 @@ data Options = Options { defaultOptions = Options { checkSpec = emptyCheckSpec, externalSources = False, + rootPaths = [], formatterOptions = newFormatterOptions { foColorOption = ColorAuto }, @@ -98,6 +100,9 @@ options = [ "Output format (" ++ formatList ++ ")", Option "" ["norc"] (NoArg $ Flag "norc" "true") "Don't look for .shellcheckrc files", + Option "r" ["root"] + (ReqArg (Flag "root") "ROOTPATHS") + "Specify alternate root path(s) when looking for sources (colon separated)", Option "s" ["shell"] (ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (sh, bash, dash, ksh)", @@ -311,6 +316,12 @@ parseOption flag options = } } + Flag "root" str -> do + let paths = filter (not . null) $ split ':' str + return options { + rootPaths = paths + } + Flag "sourced" _ -> return options { checkSpec = (checkSpec options) { @@ -362,8 +373,10 @@ ioInterface options files = do inputs <- mapM normalize files cache <- newIORef emptyCache configCache <- newIORef ("", Nothing) + let rootPathsCache = rootPaths options return SystemInterface { siReadFile = get cache inputs, + siFindSource = findSourceFile rootPathsCache, siGetConfig = getConfig configCache } where @@ -455,6 +468,23 @@ ioInterface options files = do putStrLn $ file ++ ": " ++ show err return ("", True) + findSourceFile rootPaths file = do + case file of + ('/':root) -> do + source <- find root + return source + _ -> + return file + where + find root = do + sources <- filterM doesFileExist paths + case sources of + [] -> return file + (first:_) -> return first + where + paths = map join rootPaths + join path = joinPath [path, root] + inputFile file = do (handle, shouldCache) <- if file == "-" diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index 0661386..8b0ba0f 100644 --- a/src/ShellCheck/Interface.hs +++ b/src/ShellCheck/Interface.hs @@ -73,6 +73,8 @@ import qualified Data.Map as Map data SystemInterface m = SystemInterface { -- Read a file by filename, or return an error siReadFile :: String -> m (Either ErrorMessage String), + -- Find source file in alternate root paths + siFindSource :: String -> m (FilePath), -- Get the configuration file (name, contents) for a filename siGetConfig :: String -> m (Maybe (FilePath, String)) } @@ -287,6 +289,7 @@ data ColorOption = mockedSystemInterface :: [(String, String)] -> SystemInterface Identity mockedSystemInterface files = SystemInterface { siReadFile = rf, + siFindSource = fs, siGetConfig = const $ return Nothing } where @@ -294,6 +297,7 @@ mockedSystemInterface files = SystemInterface { case filter ((== file) . fst) files of [] -> return $ Left "File not included in mock." [(_, contents)] -> return $ Right contents + fs file = return file mockRcFile rcfile mock = mock { siGetConfig = const . return $ Just (".shellcheckrc", rcfile) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 4ecf602..2abdb36 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -2087,7 +2087,9 @@ readSource t@(T_Redirecting _ _ (T_SimpleCommand cmdId _ (cmd:file':rest'))) = d input <- if filename == "/dev/null" -- always allow /dev/null then return (Right "") - else system $ siReadFile sys filename + else do + filename' <- system $ siFindSource sys filename + system $ siReadFile sys filename' case input of Left err -> do parseNoteAtId (getId file) InfoC 1091 $ From c6c12f52bdda4ee95db0b8bf65063a1d999ab65c Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Wed, 24 Apr 2019 18:51:24 -0700 Subject: [PATCH 2/2] Expand root paths into source paths --- CHANGELOG.md | 1 + shellcheck.1.md | 8 +++++ shellcheck.hs | 58 ++++++++++++++++++++----------------- src/ShellCheck/Checker.hs | 24 +++++++++++++++ src/ShellCheck/Interface.hs | 6 ++-- src/ShellCheck/Parser.hs | 3 +- 6 files changed, 70 insertions(+), 30 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0dc5bb8..d81b547 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,7 @@ - Files containing Bats tests can now be checked - Directory wide directives can now be placed in a `.shellcheckrc` - Verbose mode: Use `-S verbose` for especially pedantic suggestions +- Source paths: Use `-P dir1:dir2` to specify path for sourced files - SC2249: Warn about `case` with missing default case (verbose) - SC2248: Warn about unquoted variables without special chars (verbose) - SC2247: Warn about $"(cmd)" and $"{var}" diff --git a/shellcheck.1.md b/shellcheck.1.md index b533396..92235f9 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -67,6 +67,14 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts. : Don't try to look for .shellcheckrc configuration files. +**-P**\ *SOURCEPATH*,\ **--source-path=***SOURCEPATH* + +: Specify paths to search for sourced files, separated by `:` on Unix and + `;` on Windows. Absolute paths will also be rooted in these. The special + path `SCRIPTDIR` can be used to specify the currently checked script's + directory, as in `-P SCRIPTDIR` or `-P SCRIPTDIR/../libs`. Subsequent + `-P` flags accumulate and take predecence. + **-S**\ *SEVERITY*,\ **--severity=***severity* : Specify minimum severity of errors to consider. Valid values in order of diff --git a/shellcheck.hs b/shellcheck.hs index c57c379..ac6639a 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -69,7 +69,7 @@ instance Monoid Status where data Options = Options { checkSpec :: CheckSpec, externalSources :: Bool, - rootPaths :: [FilePath], + sourcePaths :: [FilePath], formatterOptions :: FormatterOptions, minSeverity :: Severity } @@ -77,7 +77,7 @@ data Options = Options { defaultOptions = Options { checkSpec = emptyCheckSpec, externalSources = False, - rootPaths = [], + sourcePaths = [], formatterOptions = newFormatterOptions { foColorOption = ColorAuto }, @@ -100,9 +100,9 @@ options = [ "Output format (" ++ formatList ++ ")", Option "" ["norc"] (NoArg $ Flag "norc" "true") "Don't look for .shellcheckrc files", - Option "r" ["root"] - (ReqArg (Flag "root") "ROOTPATHS") - "Specify alternate root path(s) when looking for sources (colon separated)", + Option "P" ["source-path"] + (ReqArg (Flag "source-path") "SOURCEPATHS") + "Specify path when looking for sourced files (\"SCRIPTDIR\" for script's dir)", Option "s" ["shell"] (ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (sh, bash, dash, ksh)", @@ -316,10 +316,10 @@ parseOption flag options = } } - Flag "root" str -> do - let paths = filter (not . null) $ split ':' str + Flag "source-path" str -> do + let paths = splitSearchPath str return options { - rootPaths = paths + sourcePaths = (sourcePaths options) ++ paths } Flag "sourced" _ -> @@ -373,10 +373,9 @@ ioInterface options files = do inputs <- mapM normalize files cache <- newIORef emptyCache configCache <- newIORef ("", Nothing) - let rootPathsCache = rootPaths options return SystemInterface { siReadFile = get cache inputs, - siFindSource = findSourceFile rootPathsCache, + siFindSource = findSourceFile inputs (sourcePaths options), siGetConfig = getConfig configCache } where @@ -468,22 +467,29 @@ ioInterface options files = do putStrLn $ file ++ ": " ++ show err return ("", True) - findSourceFile rootPaths file = do - case file of - ('/':root) -> do - source <- find root - return source - _ -> - return file - where - find root = do - sources <- filterM doesFileExist paths - case sources of - [] -> return file - (first:_) -> return first - where - paths = map join rootPaths - join path = joinPath [path, root] + andM a b arg = do + first <- a arg + if not first then return False else b arg + + findSourceFile inputs sourcePaths currentScript original = + if isAbsolute original + then + let (_, relative) = splitDrive original + in find relative original + else + find original original + where + find filename deflt = do + sources <- filterM ((allowable inputs) `andM` doesFileExist) + (map ( filename) $ map adjustPath sourcePaths) + case sources of + [] -> return deflt + (first:_) -> return first + scriptdir = dropFileName currentScript + adjustPath str = + case (splitDirectories str) of + ("SCRIPTDIR":rest) -> joinPath (scriptdir:rest) + _ -> str inputFile file = do (handle, shouldCache) <- diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index 471c364..b6ee068 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -150,6 +150,11 @@ checkOptionIncludes includes src = checkWithRc rc = getErrors (mockRcFile rc $ mockedSystemInterface []) +checkWithIncludesAndSourcePath includes mapper = getErrors + (mockedSystemInterface includes) { + siFindSource = mapper + } + prop_findsParseIssue = check "echo \"$12\"" == [1037] prop_commentDisablesParseIssue1 = @@ -335,5 +340,24 @@ prop_brokenRcGetsWarning = result == [1134, 2086] csIgnoreRC = False } +prop_sourcePathRedirectsName = result == [2086] + where + f "dir/myscript" "lib" = return "foo/lib" + result = checkWithIncludesAndSourcePath [("foo/lib", "echo $1")] f emptyCheckSpec { + csScript = "#!/bin/bash\nsource lib", + csFilename = "dir/myscript", + csCheckSourced = True + } + +prop_sourcePathRedirectsDirective = result == [2086] + where + f "dir/myscript" "lib" = return "foo/lib" + f _ _ = return "/dev/null" + result = checkWithIncludesAndSourcePath [("foo/lib", "echo $1")] f emptyCheckSpec { + csScript = "#!/bin/bash\n# shellcheck source=lib\nsource kittens", + csFilename = "dir/myscript", + csCheckSourced = True + } + return [] runTests = $quickCheckAll diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index 8b0ba0f..fa342e2 100644 --- a/src/ShellCheck/Interface.hs +++ b/src/ShellCheck/Interface.hs @@ -73,8 +73,8 @@ import qualified Data.Map as Map data SystemInterface m = SystemInterface { -- Read a file by filename, or return an error siReadFile :: String -> m (Either ErrorMessage String), - -- Find source file in alternate root paths - siFindSource :: String -> m (FilePath), + -- Given the current script and a sourced file, find the sourced file + siFindSource :: String -> String -> m FilePath, -- Get the configuration file (name, contents) for a filename siGetConfig :: String -> m (Maybe (FilePath, String)) } @@ -297,7 +297,7 @@ mockedSystemInterface files = SystemInterface { case filter ((== file) . fst) files of [] -> return $ Left "File not included in mock." [(_, contents)] -> return $ Right contents - fs file = return file + fs _ file = return file mockRcFile rcfile mock = mock { siGetConfig = const . return $ Just (".shellcheckrc", rcfile) diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 2abdb36..75e45ce 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -2088,7 +2088,8 @@ readSource t@(T_Redirecting _ _ (T_SimpleCommand cmdId _ (cmd:file':rest'))) = d if filename == "/dev/null" -- always allow /dev/null then return (Right "") else do - filename' <- system $ siFindSource sys filename + currentScript <- Mr.asks currentFilename + filename' <- system $ siFindSource sys currentScript filename system $ siReadFile sys filename' case input of Left err -> do