From d9e419d60fbd1507b573f33590a7f4b61841aa5b Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 9 May 2019 19:54:30 -0700 Subject: [PATCH] Add support for source-path directives (fixes #1577) --- CHANGELOG.md | 3 ++- shellcheck.1.md | 20 ++++++++++++++------ shellcheck.hs | 4 ++-- src/ShellCheck/AST.hs | 1 + src/ShellCheck/Checker.hs | 22 +++++++++++++++++++--- src/ShellCheck/Interface.hs | 10 +++++++--- src/ShellCheck/Parser.hs | 24 ++++++++++++++++++++++-- 7 files changed, 67 insertions(+), 17 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 79f7910..9cad51f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,7 +4,8 @@ - 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 +- Source paths: Use `-P dir1:dir2` or a `source-path=dir1` directive + to specify search paths 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 1cec34f..220cc04 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -70,10 +70,8 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts. **-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. + `;` on Windows. This is equivalent to specifying `search-path` + directives. **-s**\ *shell*,\ **--shell=***shell* @@ -201,6 +199,14 @@ Valid keys are: used to tell shellcheck where to look for a file whose name is determined at runtime, or to skip a source by telling it to use `/dev/null`. +**source-path** +: Add a directory to the search path for `source`/`.` statements (by default, + only ShellCheck's working directory is included). Absolute paths will also + be rooted in these paths. The special path `SCRIPTDIR` can be used to + specify the currently checked script's directory, as in + `source-path=SCRIPTDIR` or `source-path=SCRIPTDIR/../libs`. Multiple + paths accumulate, and `-P` takes precedence over them. + **shell** : Overrides the shell detected from the shebang. This is useful for files meant to be included (and thus lacking a shebang), or possibly @@ -213,8 +219,10 @@ it will read `key=value` pairs from it and treat them as file-wide directives. Here is an example `.shellcheckrc`: - # Don't suggest using -n in [ $var ] - disable=SC2244 + # Look for 'source'd files relative to the checked script, + # and also look for absolute paths in /mnt/chroot + source-path=SCRIPTDIR + source-path=/mnt/chroot # Allow using `which` since it gives full paths and is common enough disable=SC2230 diff --git a/shellcheck.hs b/shellcheck.hs index ac6639a..137aaba 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -471,7 +471,7 @@ ioInterface options files = do first <- a arg if not first then return False else b arg - findSourceFile inputs sourcePaths currentScript original = + findSourceFile inputs sourcePathFlag currentScript sourcePathAnnotation original = if isAbsolute original then let (_, relative) = splitDrive original @@ -481,7 +481,7 @@ ioInterface options files = do where find filename deflt = do sources <- filterM ((allowable inputs) `andM` doesFileExist) - (map ( filename) $ map adjustPath sourcePaths) + (map ( filename) $ map adjustPath $ sourcePathFlag ++ sourcePathAnnotation) case sources of [] -> return deflt (first:_) -> return first diff --git a/src/ShellCheck/AST.hs b/src/ShellCheck/AST.hs index aedb148..9ec892d 100644 --- a/src/ShellCheck/AST.hs +++ b/src/ShellCheck/AST.hs @@ -146,6 +146,7 @@ data Annotation = DisableComment Integer | SourceOverride String | ShellOverride String + | SourcePath String deriving (Show, Eq) data ConditionType = DoubleBracket | SingleBracket deriving (Show, Eq) diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index b6ee068..e73636d 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -215,6 +215,7 @@ prop_worksWhenSourcingWithDashDash = prop_worksWhenDotting = null $ checkWithIncludes [("lib", "bar=1")] ". lib; echo \"$bar\"" +-- FIXME: This should really be giving [1093], "recursively sourced" prop_noInfiniteSourcing = [] == checkWithIncludes [("lib", "source lib")] "source lib" @@ -236,6 +237,12 @@ prop_recursiveAnalysis = prop_recursiveParsing = [1037] == checkRecursive [("lib", "echo \"$10\"")] "source lib" +prop_nonRecursiveAnalysis = + [] == checkWithIncludes [("lib", "echo $1")] "source lib" + +prop_nonRecursiveParsing = + [] == checkWithIncludes [("lib", "echo \"$10\"")] "source lib" + prop_sourceDirectiveDoesntFollowFile = null $ checkWithIncludes [("foo", "source bar"), ("bar", "baz=3")] @@ -342,17 +349,26 @@ prop_brokenRcGetsWarning = result == [1134, 2086] prop_sourcePathRedirectsName = result == [2086] where - f "dir/myscript" "lib" = return "foo/lib" + 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_sourcePathAddsAnnotation = result == [2086] + where + f "dir/myscript" ["mypath"] "lib" = return "foo/lib" + result = checkWithIncludesAndSourcePath [("foo/lib", "echo $1")] f emptyCheckSpec { + csScript = "#!/bin/bash\n# shellcheck source-path=mypath\nsource lib", + csFilename = "dir/myscript", + csCheckSourced = True + } + prop_sourcePathRedirectsDirective = result == [2086] where - f "dir/myscript" "lib" = return "foo/lib" - f _ _ = return "/dev/null" + 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", diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index fa342e2..1d0cc6b 100644 --- a/src/ShellCheck/Interface.hs +++ b/src/ShellCheck/Interface.hs @@ -73,8 +73,12 @@ 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), - -- Given the current script and a sourced file, find the sourced file - siFindSource :: String -> String -> m FilePath, + -- Given: + -- the current script, + -- a list of source-path annotations in effect, + -- and a sourced file, + -- find the sourced file + siFindSource :: String -> [String] -> String -> m FilePath, -- Get the configuration file (name, contents) for a filename siGetConfig :: String -> m (Maybe (FilePath, String)) } @@ -297,7 +301,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 75e45ce..91bc3f1 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -264,6 +264,15 @@ shouldIgnoreCode code = do disabling' (DisableComment n) = code == n disabling' _ = False +getCurrentAnnotations includeSource = + concatMap get . takeWhile (not . isBoundary) <$> getCurrentContexts + where + get (ContextAnnotation list) = list + get _ = [] + isBoundary (ContextSource _) = not includeSource + isBoundary _ = False + + shouldFollow file = do context <- getCurrentContexts if any isThisFile context @@ -966,7 +975,7 @@ readAnnotationWithoutPrefix = do where readKey = do keyPos <- getPosition - key <- many1 letter + key <- many1 (letter <|> char '-') char '=' <|> fail "Expected '=' after directive key" annotations <- case key of "disable" -> readCode `sepBy` char ',' @@ -980,6 +989,10 @@ readAnnotationWithoutPrefix = do filename <- many1 $ noneOf " \n" return [SourceOverride filename] + "source-path" -> do + dirname <- many1 $ noneOf " \n" + return [SourcePath dirname] + "shell" -> do pos <- getPosition shell <- many1 $ noneOf " \n" @@ -2079,6 +2092,7 @@ readSource t@(T_Redirecting _ _ (T_SimpleCommand cmdId _ (cmd:file':rest'))) = d proceed <- shouldFollow filename if not proceed then do + -- FIXME: This actually gets squashed without -a parseNoteAtId (getId file) InfoC 1093 "This file appears to be recursively sourced. Ignoring." return t @@ -2089,7 +2103,8 @@ readSource t@(T_Redirecting _ _ (T_SimpleCommand cmdId _ (cmd:file':rest'))) = d then return (Right "") else do currentScript <- Mr.asks currentFilename - filename' <- system $ siFindSource sys currentScript filename + paths <- mapMaybe getSourcePath <$> getCurrentAnnotations True + filename' <- system $ siFindSource sys currentScript paths filename system $ siReadFile sys filename' case input of Left err -> do @@ -2118,6 +2133,11 @@ readSource t@(T_Redirecting _ _ (T_SimpleCommand cmdId _ (cmd:file':rest'))) = d x -> file getFile file _ = file + getSourcePath t = + case t of + SourcePath x -> Just x + _ -> Nothing + subRead name script = withContext (ContextSource name) $ inSeparateContext $