diff --git a/CHANGELOG.md b/CHANGELOG.md index 2ae3cae..4dc25f3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,7 @@ -## Git +## Git (0.8.0) ### Added +- `external-sources=true` directive can be added to .shellcheckrc to make + shellcheck behave as if `-x` was specified. - SC2286-SC2288: Warn when command name ends in a symbol like `/.)'"` - SC2289: Warn when command name contains tabs or linefeeds - SC2291: Warn about repeated unquoted spaces between words in echo diff --git a/shellcheck.1.md b/shellcheck.1.md index d038df2..070c3a4 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -112,6 +112,9 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts. line (plus `/dev/null`). This option allows following any file the script may `source`. + This option may also be enabled using `external-sources=true` in + `.shellcheckrc`. This flag takes precedence. + **FILES...** : One or more script files to check, or "-" for standard input. @@ -239,6 +242,14 @@ Valid keys are: : Enable an optional check by name, as listed with **--list-optional**. Only file-wide `enable` directives are considered. +**external-sources** +: Set to `true` in `.shellcheckrc` to always allow ShellCheck to open + arbitrary files from 'source' statements (the way most tools do). + + This option defaults to `false` only due to ShellCheck's origin as a + remote service for checking untrusted scripts. It can safely be enabled + for normal development. + **source** : Overrides the filename included by a `source`/`.` statement. This can be used to tell shellcheck where to look for a file whose name is determined @@ -270,6 +281,9 @@ Here is an example `.shellcheckrc`: source-path=SCRIPTDIR source-path=/mnt/chroot + # Allow opening any 'source'd file, even if not specified as input + external-sources=true + # Turn on warnings for unquoted variables with safe values enable=quote-safe-variables diff --git a/shellcheck.hs b/shellcheck.hs index d7e818d..bf70445 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -234,7 +234,7 @@ runFormatter sys format options files = do process :: FilePath -> IO Status process filename = do - input <- siReadFile sys filename + input <- siReadFile sys Nothing filename either (reportFailure filename) check input where check contents = do @@ -389,6 +389,7 @@ parseOption flag options = throwError SyntaxFailure return (Prelude.read num :: Integer) +ioInterface :: Options -> [FilePath] -> IO (SystemInterface IO) ioInterface options files = do inputs <- mapM normalize files cache <- newIORef emptyCache @@ -402,14 +403,14 @@ ioInterface options files = do emptyCache :: Map.Map FilePath String emptyCache = Map.empty - get cache inputs file = do + get cache inputs rcSuggestsExternal file = do map <- readIORef cache case Map.lookup file map of Just x -> return $ Right x - Nothing -> fetch cache inputs file + Nothing -> fetch cache inputs rcSuggestsExternal file - fetch cache inputs file = do - ok <- allowable inputs file + fetch cache inputs rcSuggestsExternal file = do + ok <- allowable rcSuggestsExternal inputs file if ok then (do (contents, shouldCache) <- inputFile file @@ -417,13 +418,16 @@ ioInterface options files = do modifyIORef cache $ Map.insert file contents return $ Right contents ) `catch` handler - else return $ Left (file ++ " was not specified as input (see shellcheck -x).") + else + if rcSuggestsExternal == Just False + then return $ Left (file ++ " was not specified as input, and external files were disabled via directive.") + else return $ Left (file ++ " was not specified as input (see shellcheck -x).") where handler :: IOException -> IO (Either ErrorMessage String) handler ex = return . Left $ show ex - allowable inputs x = - if externalSources options + allowable rcSuggestsExternal inputs x = + if fromMaybe (externalSources options) rcSuggestsExternal then return True else do path <- normalize x @@ -497,7 +501,7 @@ ioInterface options files = do b <- p x if b then pure (Just x) else acc - findSourceFile inputs sourcePathFlag currentScript sourcePathAnnotation original = + findSourceFile inputs sourcePathFlag currentScript rcSuggestsExternal sourcePathAnnotation original = if isAbsolute original then let (_, relative) = splitDrive original @@ -506,7 +510,7 @@ ioInterface options files = do find original original where find filename deflt = do - sources <- findM ((allowable inputs) `andM` doesFileExist) $ + sources <- findM ((allowable rcSuggestsExternal inputs) `andM` doesFileExist) $ (adjustPath filename):(map (( filename) . adjustPath) $ sourcePathFlag ++ sourcePathAnnotation) case sources of Nothing -> return deflt diff --git a/src/ShellCheck/AST.hs b/src/ShellCheck/AST.hs index 52b6e17..2cd2f6f 100644 --- a/src/ShellCheck/AST.hs +++ b/src/ShellCheck/AST.hs @@ -150,6 +150,7 @@ data Annotation = | SourceOverride String | ShellOverride String | SourcePath String + | ExternalSources Bool deriving (Show, Eq) data ConditionType = DoubleBracket | SingleBracket deriving (Show, Eq) diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index d81d664..514f97d 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -156,6 +156,11 @@ checkWithIncludesAndSourcePath includes mapper = getErrors siFindSource = mapper } +checkWithRcIncludesAndSourcePath rc includes mapper = getErrors + (mockRcFile rc $ mockedSystemInterface includes) { + siFindSource = mapper + } + prop_findsParseIssue = check "echo \"$12\"" == [1037] prop_commentDisablesParseIssue1 = @@ -384,7 +389,7 @@ prop_canEnableOptionalsWithRc = result == [2244] 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", @@ -393,7 +398,7 @@ prop_sourcePathRedirectsName = result == [2086] prop_sourcePathAddsAnnotation = result == [2086] where - f "dir/myscript" ["mypath"] "lib" = return "foo/lib" + 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", @@ -402,13 +407,75 @@ prop_sourcePathAddsAnnotation = result == [2086] 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", csCheckSourced = True } +prop_rcCanAllowExternalSources = result == [2086] + where + f "dir/myscript" (Just True) _ "mylib" = return "resolved/mylib" + f a b c d = error $ show ("Unexpected", a, b, c, d) + result = checkWithRcIncludesAndSourcePath "external-sources=true" [("resolved/mylib", "echo $1")] f emptyCheckSpec { + csScript = "#!/bin/bash\nsource mylib", + csFilename = "dir/myscript", + csCheckSourced = True + } + +prop_rcCanDenyExternalSources = result == [2086] + where + f "dir/myscript" (Just False) _ "mylib" = return "resolved/mylib" + f a b c d = error $ show ("Unexpected", a, b, c, d) + result = checkWithRcIncludesAndSourcePath "external-sources=false" [("resolved/mylib", "echo $1")] f emptyCheckSpec { + csScript = "#!/bin/bash\nsource mylib", + csFilename = "dir/myscript", + csCheckSourced = True + } + +prop_rcCanLeaveExternalSourcesUnspecified = result == [2086] + where + f "dir/myscript" Nothing _ "mylib" = return "resolved/mylib" + f a b c d = error $ show ("Unexpected", a, b, c, d) + result = checkWithRcIncludesAndSourcePath "" [("resolved/mylib", "echo $1")] f emptyCheckSpec { + csScript = "#!/bin/bash\nsource mylib", + csFilename = "dir/myscript", + csCheckSourced = True + } + +prop_fileCanDisableExternalSources = result == [2006, 2086] + where + f "dir/myscript" (Just True) _ "withExternal" = return "withExternal" + f "dir/myscript" (Just False) _ "withoutExternal" = return "withoutExternal" + f a b c d = error $ show ("Unexpected", a, b, c, d) + result = checkWithRcIncludesAndSourcePath "external-sources=true" [("withExternal", "echo $1"), ("withoutExternal", "_=`foo`")] f emptyCheckSpec { + csScript = "#!/bin/bash\ntrue\nsource withExternal\n# shellcheck external-sources=false\nsource withoutExternal", + csFilename = "dir/myscript", + csCheckSourced = True + } + +prop_fileCannotEnableExternalSources = result == [1144] + where + f "dir/myscript" Nothing _ "foo" = return "foo" + f a b c d = error $ show ("Unexpected", a, b, c, d) + result = checkWithRcIncludesAndSourcePath "" [("foo", "true")] f emptyCheckSpec { + csScript = "#!/bin/bash\n# shellcheck external-sources=true\nsource foo", + csFilename = "dir/myscript", + csCheckSourced = True + } + +prop_fileCannotEnableExternalSources2 = result == [1144] + where + f "dir/myscript" (Just False) _ "foo" = return "foo" + f a b c d = error $ show ("Unexpected", a, b, c, d) + result = checkWithRcIncludesAndSourcePath "external-sources=false" [("foo", "true")] f emptyCheckSpec { + csScript = "#!/bin/bash\n# shellcheck external-sources=true\nsource foo", + csFilename = "dir/myscript", + csCheckSourced = True + } + + return [] runTests = $quickCheckAll diff --git a/src/ShellCheck/Formatter/CheckStyle.hs b/src/ShellCheck/Formatter/CheckStyle.hs index f3fea88..c79ac21 100644 --- a/src/ShellCheck/Formatter/CheckStyle.hs +++ b/src/ShellCheck/Formatter/CheckStyle.hs @@ -48,7 +48,7 @@ outputResults cr sys = fileGroups = groupWith sourceFile comments outputGroup group = do let filename = sourceFile (head group) - result <- (siReadFile sys) filename + result <- siReadFile sys (Just True) filename let contents = either (const "") id result outputFile filename contents group diff --git a/src/ShellCheck/Formatter/Diff.hs b/src/ShellCheck/Formatter/Diff.hs index 83fb232..9e31780 100644 --- a/src/ShellCheck/Formatter/Diff.hs +++ b/src/ShellCheck/Formatter/Diff.hs @@ -90,7 +90,7 @@ reportResult foundIssues reportedIssues color result sys = do mapM_ output $ M.toList fixmap where output (name, fix) = do - file <- (siReadFile sys) name + file <- siReadFile sys (Just True) name case file of Right contents -> do putStrLn $ formatDoc color $ makeDiff name contents fix diff --git a/src/ShellCheck/Formatter/GCC.hs b/src/ShellCheck/Formatter/GCC.hs index 9c5fa5f..5106e4c 100644 --- a/src/ShellCheck/Formatter/GCC.hs +++ b/src/ShellCheck/Formatter/GCC.hs @@ -43,7 +43,7 @@ outputAll cr sys = mapM_ f groups f :: [PositionedComment] -> IO () f group = do let filename = sourceFile (head group) - result <- (siReadFile sys) filename + result <- siReadFile sys (Just True) filename let contents = either (const "") id result outputResult filename contents group diff --git a/src/ShellCheck/Formatter/JSON1.hs b/src/ShellCheck/Formatter/JSON1.hs index 7335d8c..54aad34 100644 --- a/src/ShellCheck/Formatter/JSON1.hs +++ b/src/ShellCheck/Formatter/JSON1.hs @@ -117,7 +117,7 @@ collectResult ref cr sys = mapM_ f groups f :: [PositionedComment] -> IO () f group = do let filename = sourceFile (head group) - result <- siReadFile sys filename + result <- siReadFile sys (Just True) filename let contents = either (const "") id result let comments' = makeNonVirtual comments contents modifyIORef ref (\x -> comments' ++ x) diff --git a/src/ShellCheck/Formatter/TTY.hs b/src/ShellCheck/Formatter/TTY.hs index 0d474d7..bb57894 100644 --- a/src/ShellCheck/Formatter/TTY.hs +++ b/src/ShellCheck/Formatter/TTY.hs @@ -121,7 +121,7 @@ outputResult options ref result sys = do outputForFile color sys comments = do let fileName = sourceFile (head comments) - result <- (siReadFile sys) fileName + result <- siReadFile sys (Just True) fileName let contents = either (const "") id result let fileLinesList = lines contents let lineCount = length fileLinesList diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index 87346a1..7528559 100644 --- a/src/ShellCheck/Interface.hs +++ b/src/ShellCheck/Interface.hs @@ -73,14 +73,18 @@ 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: + -- What annotations say about including external files (if anything) + -- A resolved filename from siFindSource + -- Read the file or return an error + siReadFile :: Maybe Bool -> String -> m (Either ErrorMessage String), -- | Given: -- the current script, + -- what annotations say about including external files (if anything) -- a list of source-path annotations in effect, -- and a sourced file, -- find the sourced file - siFindSource :: String -> [String] -> String -> m FilePath, + siFindSource :: String -> Maybe Bool -> [String] -> String -> m FilePath, -- | Get the configuration file (name, contents) for a filename siGetConfig :: String -> m (Maybe (FilePath, String)) } @@ -313,11 +317,11 @@ mockedSystemInterface files = SystemInterface { siGetConfig = const $ return Nothing } where - rf file = return $ + rf _ file = return $ case find ((== file) . fst) files of Nothing -> Left "File not included in mock." Just (_, contents) -> 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 45434a8..b59ebc2 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -987,9 +987,9 @@ prop_readAnnotation7 = isOk readAnnotation "# shellcheck disable=SC1000,SC2000-S readAnnotation = called "shellcheck directive" $ do try readAnnotationPrefix many1 linewhitespace - readAnnotationWithoutPrefix + readAnnotationWithoutPrefix True -readAnnotationWithoutPrefix = do +readAnnotationWithoutPrefix sandboxed = do values <- many1 readKey optional readAnyComment void linefeed <|> eof <|> do @@ -1035,6 +1035,21 @@ readAnnotationWithoutPrefix = do "This shell type is unknown. Use e.g. sh or bash." return [ShellOverride shell] + "external-sources" -> do + pos <- getPosition + value <- many1 letter + case value of + "true" -> + if sandboxed + then do + parseNoteAt pos ErrorC 1144 "external-sources can only be enabled in .shellcheckrc, not in individual files." + return [] + else return [ExternalSources True] + "false" -> return [ExternalSources False] + _ -> do + parseNoteAt pos ErrorC 1145 "Unknown external-sources value. Expected true/false." + return [] + _ -> do parseNoteAt keyPos WarningC 1107 "This directive is unknown. It will be ignored." anyChar `reluctantlyTill` whitespace @@ -2176,10 +2191,12 @@ readSource t@(T_Redirecting _ _ (T_SimpleCommand cmdId _ (cmd:file':rest'))) = d if filename == "/dev/null" -- always allow /dev/null then return (Right "", filename) else do + allAnnotations <- getCurrentAnnotations True currentScript <- Mr.asks currentFilename - paths <- mapMaybe getSourcePath <$> getCurrentAnnotations True - resolved <- system $ siFindSource sys currentScript paths filename - contents <- system $ siReadFile sys resolved + let paths = mapMaybe getSourcePath allAnnotations + let externalSources = listToMaybe $ mapMaybe getExternalSources allAnnotations + resolved <- system $ siFindSource sys currentScript externalSources paths filename + contents <- system $ siReadFile sys externalSources resolved return (contents, resolved) case input of Left err -> do @@ -2213,6 +2230,11 @@ readSource t@(T_Redirecting _ _ (T_SimpleCommand cmdId _ (cmd:file':rest'))) = d SourcePath x -> Just x _ -> Nothing + getExternalSources t = + case t of + ExternalSources b -> Just b + _ -> Nothing + -- If the word has a single expansion as the directory, try stripping it -- This affects `$foo/bar` but not `${foo}-dir/bar` or `/foo/$file` stripDynamicPrefix word = @@ -3202,7 +3224,7 @@ prop_readConfigKVs4 = isOk readConfigKVs "\n\n\n\n\t \n" prop_readConfigKVs5 = isOk readConfigKVs "# shellcheck accepts annotation-like comments in rc files\ndisable=1234" readConfigKVs = do anySpacingOrComment - annotations <- many (readAnnotationWithoutPrefix <* anySpacingOrComment) + annotations <- many (readAnnotationWithoutPrefix False <* anySpacingOrComment) eof return $ concat annotations anySpacingOrComment =