Merge branch 'grische-feature/busyboxsh-support'

This commit is contained in:
Vidar Holen 2023-12-10 17:15:57 -08:00
commit 5c50b0b189
11 changed files with 72 additions and 32 deletions

View File

@ -9,6 +9,7 @@
- SC3015: Warn bashism `test _ =~ _` like in [ ] - SC3015: Warn bashism `test _ =~ _` like in [ ]
- SC3016: Warn bashism `test -v _` like in [ ] - SC3016: Warn bashism `test -v _` like in [ ]
- SC3017: Warn bashism `test -a _` like in [ ] - SC3017: Warn bashism `test -a _` like in [ ]
- Added support for busybox sh
### Fixed ### Fixed
- source statements with here docs now work correctly - source statements with here docs now work correctly

View File

@ -85,7 +85,8 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts.
**-s**\ *shell*,\ **--shell=***shell* **-s**\ *shell*,\ **--shell=***shell*
: Specify Bourne shell dialect. Valid values are *sh*, *bash*, *dash* and *ksh*. : Specify Bourne shell dialect. Valid values are *sh*, *bash*, *dash*, *ksh*,
and *busybox*.
The default is to deduce the shell from the file's `shell` directive, The default is to deduce the shell from the file's `shell` directive,
shebang, or `.bash/.bats/.dash/.ksh` extension, in that order. *sh* refers to shebang, or `.bash/.bats/.dash/.ksh` extension, in that order. *sh* refers to
POSIX `sh` (not the system's), and will warn of portability issues. POSIX `sh` (not the system's), and will warn of portability issues.

View File

@ -115,7 +115,7 @@ options = [
"Specify path when looking for sourced files (\"SCRIPTDIR\" for script's dir)", "Specify path when looking for sourced files (\"SCRIPTDIR\" for script's dir)",
Option "s" ["shell"] Option "s" ["shell"]
(ReqArg (Flag "shell") "SHELLNAME") (ReqArg (Flag "shell") "SHELLNAME")
"Specify dialect (sh, bash, dash, ksh)", "Specify dialect (sh, bash, dash, ksh, busybox)",
Option "S" ["severity"] Option "S" ["severity"]
(ReqArg (Flag "severity") "SEVERITY") (ReqArg (Flag "severity") "SEVERITY")
"Minimum severity of errors to consider (error, warning, info, style)", "Minimum severity of errors to consider (error, warning, info, style)",

View File

@ -758,8 +758,8 @@ prop_executableFromShebang6 = executableFromShebang "/usr/bin/env --split-string
prop_executableFromShebang7 = executableFromShebang "/usr/bin/env --split-string 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_executableFromShebang8 = executableFromShebang "/usr/bin/env --split-string foo=bar bash -x" == "bash"
prop_executableFromShebang9 = executableFromShebang "/usr/bin/env foo=bar dash" == "dash" prop_executableFromShebang9 = executableFromShebang "/usr/bin/env foo=bar dash" == "dash"
prop_executableFromShebang10 = executableFromShebang "/bin/busybox sh" == "ash" prop_executableFromShebang10 = executableFromShebang "/bin/busybox sh" == "busybox sh"
prop_executableFromShebang11 = executableFromShebang "/bin/busybox ash" == "ash" prop_executableFromShebang11 = executableFromShebang "/bin/busybox ash" == "busybox ash"
-- Get the shell executable from a string like '/usr/bin/env bash' -- Get the shell executable from a string like '/usr/bin/env bash'
executableFromShebang :: String -> String executableFromShebang :: String -> String
@ -776,7 +776,8 @@ executableFromShebang = shellFor
[x] -> basename x [x] -> basename x
(first:second:args) | basename first == "busybox" -> (first:second:args) | basename first == "busybox" ->
case basename second of case basename second of
"sh" -> "ash" -- busybox sh is ash "sh" -> "busybox sh"
"ash" -> "busybox ash"
x -> x x -> x
(first:args) | basename first == "env" -> (first:args) | basename first == "env" ->
fromEnvArgs args fromEnvArgs args

View File

@ -646,10 +646,10 @@ prop_checkShebang9 = verifyNotTree checkShebang "# shellcheck shell=sh\ntrue"
prop_checkShebang10 = verifyNotTree checkShebang "#!foo\n# shellcheck shell=sh ignore=SC2239\ntrue" prop_checkShebang10 = verifyNotTree checkShebang "#!foo\n# shellcheck shell=sh ignore=SC2239\ntrue"
prop_checkShebang11 = verifyTree checkShebang "#!/bin/sh/\ntrue" prop_checkShebang11 = verifyTree checkShebang "#!/bin/sh/\ntrue"
prop_checkShebang12 = verifyTree checkShebang "#!/bin/sh/ -xe\ntrue" prop_checkShebang12 = verifyTree checkShebang "#!/bin/sh/ -xe\ntrue"
prop_checkShebang13 = verifyTree checkShebang "#!/bin/busybox sh" prop_checkShebang13 = verifyNotTree checkShebang "#!/bin/busybox sh"
prop_checkShebang14 = verifyNotTree 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_checkShebang15 = verifyNotTree checkShebang "#!/bin/busybox sh\n# shellcheck shell=dash\n"
prop_checkShebang16 = verifyTree checkShebang "#!/bin/busybox ash" prop_checkShebang16 = verifyNotTree checkShebang "#!/bin/busybox ash"
prop_checkShebang17 = verifyNotTree checkShebang "#!/bin/busybox ash\n# shellcheck shell=dash\n" prop_checkShebang17 = verifyNotTree checkShebang "#!/bin/busybox ash\n# shellcheck shell=dash\n"
prop_checkShebang18 = verifyNotTree checkShebang "#!/bin/busybox ash\n# shellcheck shell=sh\n" prop_checkShebang18 = verifyNotTree checkShebang "#!/bin/busybox ash\n# shellcheck shell=sh\n"
checkShebang params (T_Annotation _ list t) = checkShebang params (T_Annotation _ list t) =
@ -1204,6 +1204,7 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do
case shellType params of case shellType params of
Sh -> return () -- These are unsupported and will be caught by bashism checks. Sh -> return () -- These are unsupported and will be caught by bashism checks.
Dash -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting." Dash -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting."
BusyboxSh -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting."
_ -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting (or switch to [[ .. ]])." _ -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting (or switch to [[ .. ]])."
when (op `elem` arithmeticBinaryTestOps) $ do when (op `elem` arithmeticBinaryTestOps) $ do
@ -2782,6 +2783,7 @@ checkFunctionDeclarations params
when (hasKeyword && hasParens) $ when (hasKeyword && hasParens) $
err id 2111 "ksh does not allow 'function' keyword and '()' at the same time." err id 2111 "ksh does not allow 'function' keyword and '()' at the same time."
Dash -> forSh Dash -> forSh
BusyboxSh -> forSh
Sh -> forSh Sh -> forSh
where where
@ -4044,7 +4046,8 @@ prop_checkModifiedArithmeticInRedirection3 = verifyNot checkModifiedArithmeticIn
prop_checkModifiedArithmeticInRedirection4 = verify checkModifiedArithmeticInRedirection "cat <<< $((i++))" prop_checkModifiedArithmeticInRedirection4 = verify checkModifiedArithmeticInRedirection "cat <<< $((i++))"
prop_checkModifiedArithmeticInRedirection5 = verify checkModifiedArithmeticInRedirection "cat << foo\n$((i++))\nfoo\n" prop_checkModifiedArithmeticInRedirection5 = verify checkModifiedArithmeticInRedirection "cat << foo\n$((i++))\nfoo\n"
prop_checkModifiedArithmeticInRedirection6 = verifyNot checkModifiedArithmeticInRedirection "#!/bin/dash\nls > $((i=i+1))" prop_checkModifiedArithmeticInRedirection6 = verifyNot checkModifiedArithmeticInRedirection "#!/bin/dash\nls > $((i=i+1))"
checkModifiedArithmeticInRedirection params t = unless (shellType params == Dash) $ prop_checkModifiedArithmeticInRedirection7 = verifyNot checkModifiedArithmeticInRedirection "#!/bin/busybox sh\ncat << foo\n$((i++))\nfoo\n"
checkModifiedArithmeticInRedirection params t = unless (shellType params == Dash || shellType params == BusyboxSh) $
case t of case t of
T_Redirecting _ redirs (T_SimpleCommand _ _ (_:_)) -> mapM_ checkRedirs redirs T_Redirecting _ redirs (T_SimpleCommand _ _ (_:_)) -> mapM_ checkRedirs redirs
_ -> return () _ -> return ()
@ -4356,6 +4359,7 @@ checkEqualsInCommand params originalToken =
Bash -> errWithFix id 2277 "Use BASH_ARGV0 to assign to $0 in bash (or use [ ] to compare)." bashfix Bash -> errWithFix id 2277 "Use BASH_ARGV0 to assign to $0 in bash (or use [ ] to compare)." bashfix
Ksh -> err id 2278 "$0 can't be assigned in Ksh (but it does reflect the current function)." Ksh -> err id 2278 "$0 can't be assigned in Ksh (but it does reflect the current function)."
Dash -> err id 2279 "$0 can't be assigned in Dash. This becomes a command name." Dash -> err id 2279 "$0 can't be assigned in Dash. This becomes a command name."
BusyboxSh -> err id 2279 "$0 can't be assigned in Busybox Ash. This becomes a command name."
_ -> err id 2280 "$0 can't be assigned this way, and there is no portable alternative." _ -> err id 2280 "$0 can't be assigned this way, and there is no portable alternative."
leadingNumberMsg id = leadingNumberMsg id =
err id 2282 "Variable names can't start with numbers, so this is interpreted as a command." err id 2282 "Variable names can't start with numbers, so this is interpreted as a command."

View File

@ -206,18 +206,21 @@ makeParameters spec = params
case shellType params of case shellType params of
Bash -> isOptionSet "lastpipe" root Bash -> isOptionSet "lastpipe" root
Dash -> False Dash -> False
BusyboxSh -> False
Sh -> False Sh -> False
Ksh -> True, Ksh -> True,
hasInheritErrexit = hasInheritErrexit =
case shellType params of case shellType params of
Bash -> isOptionSet "inherit_errexit" root Bash -> isOptionSet "inherit_errexit" root
Dash -> True Dash -> True
BusyboxSh -> True
Sh -> True Sh -> True
Ksh -> False, Ksh -> False,
hasPipefail = hasPipefail =
case shellType params of case shellType params of
Bash -> isOptionSet "pipefail" root Bash -> isOptionSet "pipefail" root
Dash -> True Dash -> True
BusyboxSh -> isOptionSet "pipefail" root
Sh -> True Sh -> True
Ksh -> isOptionSet "pipefail" root, Ksh -> isOptionSet "pipefail" root,
shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec), shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec),
@ -284,8 +287,8 @@ prop_determineShell7 = determineShellTest "#! /bin/ash" == Dash
prop_determineShell8 = determineShellTest' (Just Ksh) "#!/bin/sh" == Sh prop_determineShell8 = determineShellTest' (Just Ksh) "#!/bin/sh" == Sh
prop_determineShell9 = determineShellTest "#!/bin/env -S dash -x" == Dash prop_determineShell9 = determineShellTest "#!/bin/env -S dash -x" == Dash
prop_determineShell10 = determineShellTest "#!/bin/env --split-string= 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_determineShell11 = determineShellTest "#!/bin/busybox sh" == BusyboxSh -- busybox sh is a specific shell, not posix sh
prop_determineShell12 = determineShellTest "#!/bin/busybox ash" == Dash prop_determineShell12 = determineShellTest "#!/bin/busybox ash" == BusyboxSh
determineShellTest = determineShellTest' Nothing determineShellTest = determineShellTest' Nothing
determineShellTest' fallbackShell = determineShell fallbackShell . fromJust . prRoot . pScript determineShellTest' fallbackShell = determineShell fallbackShell . fromJust . prRoot . pScript
@ -899,6 +902,7 @@ isBashLike params =
Bash -> True Bash -> True
Ksh -> True Ksh -> True
Dash -> False Dash -> False
BusyboxSh -> False
Sh -> False Sh -> False
isTrueAssignmentSource c = isTrueAssignmentSource c =

View File

@ -930,7 +930,7 @@ prop_checkTimedCommand2 = verify checkTimedCommand "#!/bin/dash\ntime ( foo; bar
prop_checkTimedCommand3 = verifyNot checkTimedCommand "#!/bin/sh\ntime sleep 1" prop_checkTimedCommand3 = verifyNot checkTimedCommand "#!/bin/sh\ntime sleep 1"
checkTimedCommand = CommandCheck (Exactly "time") f where checkTimedCommand = CommandCheck (Exactly "time") f where
f (T_SimpleCommand _ _ (c:args@(_:_))) = f (T_SimpleCommand _ _ (c:args@(_:_))) =
whenShell [Sh, Dash] $ do whenShell [Sh, Dash, BusyboxSh] $ do
let cmd = last args -- "time" is parsed with a command as argument let cmd = last args -- "time" is parsed with a command as argument
when (isPiped cmd) $ when (isPiped cmd) $
warn (getId c) 2176 "'time' is undefined for pipelines. time single stage or bash -c instead." warn (getId c) 2176 "'time' is undefined for pipelines. time single stage or bash -c instead."
@ -954,7 +954,7 @@ checkTimedCommand = CommandCheck (Exactly "time") f where
prop_checkLocalScope1 = verify checkLocalScope "local foo=3" prop_checkLocalScope1 = verify checkLocalScope "local foo=3"
prop_checkLocalScope2 = verifyNot checkLocalScope "f() { local foo=3; }" prop_checkLocalScope2 = verifyNot checkLocalScope "f() { local foo=3; }"
checkLocalScope = CommandCheck (Exactly "local") $ \t -> checkLocalScope = CommandCheck (Exactly "local") $ \t ->
whenShell [Bash, Dash] $ do -- Ksh allows it, Sh doesn't support local whenShell [Bash, Dash, BusyboxSh] $ do -- Ksh allows it, Sh doesn't support local
path <- getPathM t path <- getPathM t
unless (any isFunctionLike path) $ unless (any isFunctionLike path) $
err (getId $ getCommandTokenOrThis t) 2168 "'local' is only valid in functions." err (getId $ getCommandTokenOrThis t) 2168 "'local' is only valid in functions."

View File

@ -76,7 +76,7 @@ verifyNot c s = producesComments (testChecker c) s == Just False
prop_checkForDecimals1 = verify checkForDecimals "((3.14*c))" prop_checkForDecimals1 = verify checkForDecimals "((3.14*c))"
prop_checkForDecimals2 = verify checkForDecimals "foo[1.2]=bar" prop_checkForDecimals2 = verify checkForDecimals "foo[1.2]=bar"
prop_checkForDecimals3 = verifyNot checkForDecimals "declare -A foo; foo[1.2]=bar" prop_checkForDecimals3 = verifyNot checkForDecimals "declare -A foo; foo[1.2]=bar"
checkForDecimals = ForShell [Sh, Dash, Bash] f checkForDecimals = ForShell [Sh, Dash, BusyboxSh, Bash] f
where where
f t@(TA_Expansion id _) = sequence_ $ do f t@(TA_Expansion id _) = sequence_ $ do
str <- getLiteralString t str <- getLiteralString t
@ -196,14 +196,32 @@ prop_checkBashisms101 = verify checkBashisms "read"
prop_checkBashisms102 = verifyNot checkBashisms "read -r foo" prop_checkBashisms102 = verifyNot checkBashisms "read -r foo"
prop_checkBashisms103 = verifyNot checkBashisms "read foo" prop_checkBashisms103 = verifyNot checkBashisms "read foo"
prop_checkBashisms104 = verifyNot checkBashisms "read ''" prop_checkBashisms104 = verifyNot checkBashisms "read ''"
checkBashisms = ForShell [Sh, Dash] $ \t -> do prop_checkBashisms105 = verifyNot checkBashisms "#!/bin/busybox sh\nset -o pipefail"
prop_checkBashisms106 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[[ \"$x\" = \"$x\" ]]"
prop_checkBashisms107 = verifyNot checkBashisms "#!/bin/busybox sh\nx=x\n[ \"$x\" == \"$x\" ]"
prop_checkBashisms108 = verifyNot checkBashisms "#!/bin/busybox sh\necho magic &> /dev/null"
prop_checkBashisms109 = verifyNot checkBashisms "#!/bin/busybox sh\ntrap stop EXIT SIGTERM"
prop_checkBashisms110 = verifyNot checkBashisms "#!/bin/busybox sh\nsource /dev/null"
prop_checkBashisms111 = verify checkBashisms "#!/bin/dash\nx='test'\n${x:0:3}" -- SC3057
prop_checkBashisms112 = verifyNot checkBashisms "#!/bin/busybox sh\nx='test'\n${x:0:3}" -- SC3057
prop_checkBashisms113 = verify checkBashisms "#!/bin/dash\nx='test'\n${x/st/xt}" -- SC3060
prop_checkBashisms114 = verifyNot checkBashisms "#!/bin/busybox sh\nx='test'\n${x/st/xt}" -- SC3060
prop_checkBashisms115 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${!x}" -- SC3053
prop_checkBashisms116 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${x[1]}" -- SC3054
prop_checkBashisms117 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${!x[@]}" -- SC3055
prop_checkBashisms118 = verify checkBashisms "#!/bin/busybox sh\nxyz=1\n${!x*}" -- SC3056
prop_checkBashisms119 = verify checkBashisms "#!/bin/busybox sh\nx='test'\n${x^^[t]}" -- SC3059
prop_checkBashisms120 = verify checkBashisms "#!/bin/sh\n[ x == y ]"
prop_checkBashisms121 = verifyNot checkBashisms "#!/bin/sh\n# shellcheck shell=busybox\n[ x == y ]"
checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do
params <- ask params <- ask
kludge params t kludge params t
where where
-- This code was copy-pasted from Analytics where params was a variable -- This code was copy-pasted from Analytics where params was a variable
kludge params = bashism kludge params = bashism
where where
isDash = shellType params == Dash isBusyboxSh = shellType params == BusyboxSh
isDash = shellType params == Dash || isBusyboxSh
warnMsg id code s = warnMsg id code s =
if isDash if isDash
then err id code $ "In dash, " ++ s ++ " not supported." then err id code $ "In dash, " ++ s ++ " not supported."
@ -219,7 +237,8 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do
bashism (T_DollarBracket id _) = warnMsg id 3007 "$[..] in place of $((..)) is" bashism (T_DollarBracket id _) = warnMsg id 3007 "$[..] in place of $((..)) is"
bashism (T_SelectIn id _ _ _) = warnMsg id 3008 "select loops are" bashism (T_SelectIn id _ _ _) = warnMsg id 3008 "select loops are"
bashism (T_BraceExpansion id _) = warnMsg id 3009 "brace expansion is" bashism (T_BraceExpansion id _) = warnMsg id 3009 "brace expansion is"
bashism (T_Condition id DoubleBracket _) = warnMsg id 3010 "[[ ]] is" bashism (T_Condition id DoubleBracket _) =
unless isBusyboxSh $ warnMsg id 3010 "[[ ]] is"
bashism (T_HereString id _) = warnMsg id 3011 "here-strings are" bashism (T_HereString id _) = warnMsg id 3011 "here-strings are"
bashism (TC_Binary id SingleBracket op _ _) bashism (TC_Binary id SingleBracket op _ _)
| op `elem` [ "<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="] = | op `elem` [ "<", ">", "\\<", "\\>", "<=", ">=", "\\<=", "\\>="] =
@ -234,9 +253,9 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do
| op `elem` [ "-ot", "-nt", "-ef" ] = | op `elem` [ "-ot", "-nt", "-ef" ] =
unless isDash $ warnMsg id 3013 $ op ++ " is" unless isDash $ warnMsg id 3013 $ op ++ " is"
bashism (TC_Binary id SingleBracket "==" _ _) = bashism (TC_Binary id SingleBracket "==" _ _) =
warnMsg id 3014 "== in place of = is" unless isBusyboxSh $ warnMsg id 3014 "== in place of = is"
bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just "==", rhs]) = bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just "==", rhs]) =
warnMsg id 3014 "== in place of = is" unless isBusyboxSh $ warnMsg id 3014 "== in place of = is"
bashism (TC_Binary id SingleBracket "=~" _ _) = bashism (TC_Binary id SingleBracket "=~" _ _) =
warnMsg id 3015 "=~ regex matching is" warnMsg id 3015 "=~ regex matching is"
bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just "=~", rhs]) = bashism (T_SimpleCommand id _ [asStr -> Just "test", lhs, asStr -> Just "=~", rhs]) =
@ -253,7 +272,8 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do
| op `elem` [ "|++", "|--", "++|", "--|"] = | op `elem` [ "|++", "|--", "++|", "--|"] =
warnMsg id 3018 $ filter (/= '|') op ++ " is" warnMsg id 3018 $ filter (/= '|') op ++ " is"
bashism (TA_Binary id "**" _ _) = warnMsg id 3019 "exponentials are" bashism (TA_Binary id "**" _ _) = warnMsg id 3019 "exponentials are"
bashism (T_FdRedirect id "&" (T_IoFile _ (T_Greater _) _)) = warnMsg id 3020 "&> is" bashism (T_FdRedirect id "&" (T_IoFile _ (T_Greater _) _)) =
unless isBusyboxSh $ warnMsg id 3020 "&> is"
bashism (T_FdRedirect id "" (T_IoFile _ (T_GREATAND _) file)) = bashism (T_FdRedirect id "" (T_IoFile _ (T_GREATAND _) file)) =
unless (all isDigit $ onlyLiteralString file) $ warnMsg id 3021 ">& filename (as opposed to >& fd) is" unless (all isDigit $ onlyLiteralString file) $ warnMsg id 3021 ">& filename (as opposed to >& fd) is"
bashism (T_FdRedirect id ('{':_) _) = warnMsg id 3022 "named file descriptors are" bashism (T_FdRedirect id ('{':_) _) = warnMsg id 3022 "named file descriptors are"
@ -273,7 +293,8 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do
warnMsg id 3028 $ str ++ " is" warnMsg id 3028 $ str ++ " is"
bashism t@(T_DollarBraced id _ token) = do bashism t@(T_DollarBraced id _ token) = do
mapM_ check expansion unless isBusyboxSh $ mapM_ check simpleExpansions
mapM_ check advancedExpansions
when (isBashVariable var) $ when (isBashVariable var) $
warnMsg id 3028 $ var ++ " is" warnMsg id 3028 $ var ++ " is"
where where
@ -383,7 +404,8 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do
(\x -> (not . null . snd $ x) && snd x `notElem` allowed) flags (\x -> (not . null . snd $ x) && snd x `notElem` allowed) flags
return . warnMsg (getId word) 3045 $ name ++ " -" ++ flag ++ " is" return . warnMsg (getId word) 3045 $ name ++ " -" ++ flag ++ " is"
when (name == "source") $ warnMsg id 3046 "'source' in place of '.' is" when (name == "source" && not isBusyboxSh) $
warnMsg id 3046 "'source' in place of '.' is"
when (name == "trap") $ when (name == "trap") $
let let
check token = sequence_ $ do check token = sequence_ $ do
@ -392,7 +414,7 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do
return $ do return $ do
when (upper `elem` ["ERR", "DEBUG", "RETURN"]) $ when (upper `elem` ["ERR", "DEBUG", "RETURN"]) $
warnMsg (getId token) 3047 $ "trapping " ++ str ++ " is" warnMsg (getId token) 3047 $ "trapping " ++ str ++ " is"
when ("SIG" `isPrefixOf` upper) $ when (not isBusyboxSh && "SIG" `isPrefixOf` upper) $
warnMsg (getId token) 3048 warnMsg (getId token) 3048
"prefixing signal names with 'SIG' is" "prefixing signal names with 'SIG' is"
when (not isDash && upper /= str) $ when (not isDash && upper /= str) $
@ -432,7 +454,9 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do
("wait", Just []) ("wait", Just [])
] ]
bashism t@(T_SourceCommand id src _) bashism t@(T_SourceCommand id src _)
| getCommandName src == Just "source" = warnMsg id 3051 "'source' in place of '.' is" | getCommandName src == Just "source" =
unless isBusyboxSh $
warnMsg id 3051 "'source' in place of '.' is"
bashism (TA_Expansion _ (T_Literal id str : _)) bashism (TA_Expansion _ (T_Literal id str : _))
| str `matches` radix = warnMsg id 3052 "arithmetic base conversion is" | str `matches` radix = warnMsg id 3052 "arithmetic base conversion is"
where where
@ -440,14 +464,16 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do
bashism _ = return () bashism _ = return ()
varChars="_0-9a-zA-Z" varChars="_0-9a-zA-Z"
expansion = let re = mkRegex in [ advancedExpansions = let re = mkRegex in [
(re $ "^![" ++ varChars ++ "]", 3053, "indirect expansion is"), (re $ "^![" ++ varChars ++ "]", 3053, "indirect expansion is"),
(re $ "^[" ++ varChars ++ "]+\\[.*\\]$", 3054, "array references are"), (re $ "^[" ++ varChars ++ "]+\\[.*\\]$", 3054, "array references are"),
(re $ "^![" ++ varChars ++ "]+\\[[*@]]$", 3055, "array key expansion is"), (re $ "^![" ++ varChars ++ "]+\\[[*@]]$", 3055, "array key expansion is"),
(re $ "^![" ++ varChars ++ "]+[*@]$", 3056, "name matching prefixes are"), (re $ "^![" ++ varChars ++ "]+[*@]$", 3056, "name matching prefixes are"),
(re $ "^[" ++ varChars ++ "*@]+(\\[.*\\])?[,^]", 3059, "case modification is")
]
simpleExpansions = let re = mkRegex in [
(re $ "^[" ++ varChars ++ "*@]+:[^-=?+]", 3057, "string indexing is"), (re $ "^[" ++ varChars ++ "*@]+:[^-=?+]", 3057, "string indexing is"),
(re $ "^([*@][%#]|#[@*])", 3058, "string operations on $@/$* are"), (re $ "^([*@][%#]|#[@*])", 3058, "string operations on $@/$* are"),
(re $ "^[" ++ varChars ++ "*@]+(\\[.*\\])?[,^]", 3059, "case modification is"),
(re $ "^[" ++ varChars ++ "*@]+(\\[.*\\])?/", 3060, "string replacement is") (re $ "^[" ++ varChars ++ "*@]+(\\[.*\\])?/", 3060, "string replacement is")
] ]
bashVars = [ bashVars = [
@ -590,7 +616,7 @@ checkPS1Assignments = ForShell [Bash] f
prop_checkMultipleBangs1 = verify checkMultipleBangs "! ! true" prop_checkMultipleBangs1 = verify checkMultipleBangs "! ! true"
prop_checkMultipleBangs2 = verifyNot checkMultipleBangs "! true" prop_checkMultipleBangs2 = verifyNot checkMultipleBangs "! true"
checkMultipleBangs = ForShell [Dash, Sh] f checkMultipleBangs = ForShell [Dash, BusyboxSh, Sh] f
where where
f token = case token of f token = case token of
T_Banged id (T_Banged _ _) -> T_Banged id (T_Banged _ _) ->
@ -601,7 +627,7 @@ checkMultipleBangs = ForShell [Dash, Sh] f
prop_checkBangAfterPipe1 = verify checkBangAfterPipe "true | ! true" prop_checkBangAfterPipe1 = verify checkBangAfterPipe "true | ! true"
prop_checkBangAfterPipe2 = verifyNot checkBangAfterPipe "true | ( ! true )" prop_checkBangAfterPipe2 = verifyNot checkBangAfterPipe "true | ( ! true )"
prop_checkBangAfterPipe3 = verifyNot checkBangAfterPipe "! ! true | true" prop_checkBangAfterPipe3 = verifyNot checkBangAfterPipe "! ! true | true"
checkBangAfterPipe = ForShell [Dash, Sh, Bash] f checkBangAfterPipe = ForShell [Dash, BusyboxSh, Sh, Bash] f
where where
f token = case token of f token = case token of
T_Pipeline _ _ cmds -> mapM_ check cmds T_Pipeline _ _ cmds -> mapM_ check cmds

View File

@ -156,6 +156,9 @@ shellForExecutable name =
"sh" -> return Sh "sh" -> return Sh
"bash" -> return Bash "bash" -> return Bash
"bats" -> return Bash "bats" -> return Bash
"busybox" -> return BusyboxSh -- Used for directives and --shell=busybox
"busybox sh" -> return BusyboxSh
"busybox ash" -> return BusyboxSh
"dash" -> return Dash "dash" -> return Dash
"ash" -> return Dash -- There's also a warning for this. "ash" -> return Dash -- There's also a warning for this.
"ksh" -> return Ksh "ksh" -> return Ksh

View File

@ -28,7 +28,7 @@ module ShellCheck.Interface
, AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asOptionalChecks) , AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asOptionalChecks)
, AnalysisResult(arComments) , AnalysisResult(arComments)
, FormatterOptions(foColorOption, foWikiLinkCount) , FormatterOptions(foColorOption, foWikiLinkCount)
, Shell(Ksh, Sh, Bash, Dash) , Shell(Ksh, Sh, Bash, Dash, BusyboxSh)
, ExecutionMode(Executed, Sourced) , ExecutionMode(Executed, Sourced)
, ErrorMessage , ErrorMessage
, Code , Code
@ -221,7 +221,7 @@ newCheckDescription = CheckDescription {
} }
-- Supporting data types -- Supporting data types
data Shell = Ksh | Sh | Bash | Dash deriving (Show, Eq) data Shell = Ksh | Sh | Bash | Dash | BusyboxSh deriving (Show, Eq)
data ExecutionMode = Executed | Sourced deriving (Show, Eq) data ExecutionMode = Executed | Sourced deriving (Show, Eq)
type ErrorMessage = String type ErrorMessage = String
@ -335,4 +335,3 @@ mockedSystemInterface files = (newSystemInterface :: SystemInterface Identity) {
mockRcFile rcfile mock = mock { mockRcFile rcfile mock = mock {
siGetConfig = const . return $ Just (".shellcheckrc", rcfile) siGetConfig = const . return $ Just (".shellcheckrc", rcfile)
} }

View File

@ -3349,8 +3349,8 @@ readScriptFile sourced = do
verifyShebang pos s = do verifyShebang pos s = do
case isValidShell s of case isValidShell s of
Just True -> return () Just True -> return ()
Just False -> parseProblemAt pos ErrorC 1071 "ShellCheck only supports sh/bash/dash/ksh scripts. Sorry!" Just False -> parseProblemAt pos ErrorC 1071 "ShellCheck only supports sh/bash/dash/ksh/'busybox sh' scripts. Sorry!"
Nothing -> parseProblemAt pos ErrorC 1008 "This shebang was unrecognized. ShellCheck only supports sh/bash/dash/ksh. Add a 'shell' directive to specify." Nothing -> parseProblemAt pos ErrorC 1008 "This shebang was unrecognized. ShellCheck only supports sh/bash/dash/ksh/'busybox sh'. Add a 'shell' directive to specify."
isValidShell s = isValidShell s =
let good = null s || any (`isPrefixOf` s) goodShells let good = null s || any (`isPrefixOf` s) goodShells
@ -3366,6 +3366,7 @@ readScriptFile sourced = do
"sh", "sh",
"ash", "ash",
"dash", "dash",
"busybox sh",
"bash", "bash",
"bats", "bats",
"ksh" "ksh"