diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index c5f1735..019fc3c 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -17,9 +17,11 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . -} +{-# LANGUAGE TemplateHaskell #-} module ShellCheck.ASTLib where import ShellCheck.AST +import ShellCheck.Regex import Control.Monad.Writer import Control.Monad @@ -31,6 +33,8 @@ import Data.Maybe import qualified Data.Map as Map import Numeric (showHex) +import Test.QuickCheck + arguments (T_SimpleCommand _ _ (cmd:args)) = args -- Is this a type of loop? @@ -672,3 +676,43 @@ isAnnotationIgnoringCode code t = where hasNum (DisableComment from to) = code >= from && code < to hasNum _ = False + +prop_executableFromShebang1 = executableFromShebang "/bin/sh" == "sh" +prop_executableFromShebang2 = executableFromShebang "/bin/bash" == "bash" +prop_executableFromShebang3 = executableFromShebang "/usr/bin/env ksh" == "ksh" +prop_executableFromShebang4 = executableFromShebang "/usr/bin/env -S foo=bar bash -x" == "bash" +prop_executableFromShebang5 = executableFromShebang "/usr/bin/env --split-string=bash -x" == "bash" +prop_executableFromShebang6 = executableFromShebang "/usr/bin/env --split-string=foo=bar bash -x" == "bash" +prop_executableFromShebang7 = executableFromShebang "/usr/bin/env --split-string bash -x" == "bash" +prop_executableFromShebang8 = executableFromShebang "/usr/bin/env --split-string foo=bar bash -x" == "bash" +prop_executableFromShebang9 = executableFromShebang "/usr/bin/env foo=bar dash" == "dash" +prop_executableFromShebang10 = executableFromShebang "/bin/busybox sh" == "ash" +prop_executableFromShebang11 = executableFromShebang "/bin/busybox ash" == "ash" + +-- Get the shell executable from a string like '/usr/bin/env bash' +executableFromShebang :: String -> String +executableFromShebang = shellFor + where + re = mkRegex "/env +(-S|--split-string=?)? *(.*)" + shellFor s | s `matches` re = + case matchRegex re s of + Just [flag, shell] -> fromEnvArgs (words shell) + _ -> "" + shellFor sb = + case words sb of + [] -> "" + [x] -> basename x + (first:second:args) | basename first == "busybox" -> + case basename second of + "sh" -> "ash" -- busybox sh is ash + x -> x + (first:args) | basename first == "env" -> + fromEnvArgs args + (first:_) -> basename first + + fromEnvArgs args = fromMaybe "" $ find (notElem '=') $ skipFlags args + basename s = reverse . takeWhile (/= '/') . reverse $ s + skipFlags = dropWhile ("-" `isPrefixOf`) + +return [] +runTests = $quickCheckAll diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 160ae95..9035e04 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -591,7 +591,7 @@ prop_checkShebang10= verifyNotTree checkShebang "#!foo\n# shellcheck shell=sh ig prop_checkShebang11= verifyTree checkShebang "#!/bin/sh/\ntrue" prop_checkShebang12= verifyTree checkShebang "#!/bin/sh/ -xe\ntrue" prop_checkShebang13= verifyTree checkShebang "#!/bin/busybox sh" -prop_checkShebang14= verifyTree checkShebang "#!/bin/busybox sh\n# shellcheck shell=sh\n" +prop_checkShebang14= verifyNotTree checkShebang "#!/bin/busybox sh\n# shellcheck shell=sh\n" prop_checkShebang15= verifyNotTree checkShebang "#!/bin/busybox sh\n# shellcheck shell=dash\n" prop_checkShebang16= verifyTree checkShebang "#!/bin/busybox ash" prop_checkShebang17= verifyNotTree checkShebang "#!/bin/busybox ash\n# shellcheck shell=dash\n" diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index d3b1134..5b97e87 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -240,6 +240,8 @@ prop_determineShell7 = determineShellTest "#! /bin/ash" == Dash prop_determineShell8 = determineShellTest' (Just Ksh) "#!/bin/sh" == Sh prop_determineShell9 = determineShellTest "#!/bin/env -S dash -x" == Dash prop_determineShell10 = determineShellTest "#!/bin/env --split-string= dash -x" == Dash +prop_determineShell11 = determineShellTest "#!/bin/busybox sh" == Dash -- busybox sh is a specific shell, not posix sh +prop_determineShell12 = determineShellTest "#!/bin/busybox ash" == Dash determineShellTest = determineShellTest' Nothing determineShellTest' fallbackShell = determineShell fallbackShell . fromJust . prRoot . pScript @@ -253,19 +255,6 @@ determineShell fallbackShell t = fromMaybe Bash $ headOrDefault (fromShebang s) [s | ShellOverride s <- annotations] fromShebang (T_Script _ (T_Literal _ s) _) = executableFromShebang s --- Given a string like "/bin/bash" or "/usr/bin/env dash", --- return the shell basename like "bash" or "dash" -executableFromShebang :: String -> String -executableFromShebang = shellFor - where - shellFor s | "/env " `isInfixOf` s = case matchRegex re s of - Just [flag, shell] -> shell - _ -> "" - shellFor s | ' ' `elem` s = shellFor $ takeWhile (/= ' ') s - shellFor s = reverse . takeWhile (/= '/') . reverse $ s - re = mkRegex "/env +(-S|--split-string=?)? *([^ ]*)" - - -- Given a root node, make a map from Id to parent Token. -- This is used to populate parentMap in Parameters getParentTree :: Token -> Map.Map Id Token diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 70ea05d..f32c20b 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -24,7 +24,7 @@ module ShellCheck.Parser (parseScript, runTests) where import ShellCheck.AST -import ShellCheck.ASTLib +import ShellCheck.ASTLib hiding (runTests) import ShellCheck.Data import ShellCheck.Interface @@ -3216,8 +3216,8 @@ readScriptFile sourced = do let ignoreShebang = shellAnnotationSpecified || shellFlagSpecified unless ignoreShebang $ - verifyShebang pos (getShell shebangString) - if ignoreShebang || isValidShell (getShell shebangString) /= Just False + verifyShebang pos (executableFromShebang shebangString) + if ignoreShebang || isValidShell (executableFromShebang shebangString) /= Just False then do commands <- withAnnotations annotations readCompoundListOrEmpty id <- endSpan start @@ -3231,18 +3231,6 @@ readScriptFile sourced = do return $ T_Script id shebang [] where - basename s = reverse . takeWhile (/= '/') . reverse $ s - skipFlags = dropWhile ("-" `isPrefixOf`) - getShell sb = - case words sb of - [] -> "" - [x] -> basename x - (first:args) | basename first == "env" -> - fromMaybe "" $ find (notElem '=') $ skipFlags args - (first:second:args) | basename first == "busybox" -> - second - (first:_) -> basename first - verifyShebang pos s = do case isValidShell s of Just True -> return () diff --git a/test/shellcheck.hs b/test/shellcheck.hs index ac84116..e463403 100644 --- a/test/shellcheck.hs +++ b/test/shellcheck.hs @@ -4,6 +4,7 @@ import Control.Monad import System.Exit import qualified ShellCheck.Analytics import qualified ShellCheck.AnalyzerLib +import qualified ShellCheck.ASTLib import qualified ShellCheck.Checker import qualified ShellCheck.Checks.Commands import qualified ShellCheck.Checks.Custom @@ -17,6 +18,7 @@ main = do results <- sequence [ ShellCheck.Analytics.runTests ,ShellCheck.AnalyzerLib.runTests + ,ShellCheck.ASTLib.runTests ,ShellCheck.Checker.runTests ,ShellCheck.Checks.Commands.runTests ,ShellCheck.Checks.Custom.runTests