1{-
2    Copyright 2012-2020 Vidar Holen
3
4    This file is part of ShellCheck.
5    https://www.shellcheck.net
6
7    ShellCheck is free software: you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation, either version 3 of the License, or
10    (at your option) any later version.
11
12    ShellCheck is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <https://www.gnu.org/licenses/>.
19-}
20{-# LANGUAGE TemplateHaskell #-}
21module ShellCheck.Checker (checkScript, ShellCheck.Checker.runTests) where
22
23import ShellCheck.Interface
24import ShellCheck.Parser
25import ShellCheck.Analyzer
26
27import Data.Either
28import Data.Functor
29import Data.List
30import Data.Maybe
31import Data.Ord
32import Control.Monad.Identity
33import qualified Data.Map as Map
34import qualified System.IO
35import Prelude hiding (readFile)
36import Control.Monad
37
38import Test.QuickCheck.All
39
40tokenToPosition startMap t = fromMaybe fail $ do
41    span <- Map.lookup (tcId t) startMap
42    return $ newPositionedComment {
43        pcStartPos = fst span,
44        pcEndPos = snd span,
45        pcComment = tcComment t,
46        pcFix = tcFix t
47    }
48  where
49    fail = error "Internal shellcheck error: id doesn't exist. Please report!"
50
51shellFromFilename filename = listToMaybe candidates
52  where
53    shellExtensions = [(".ksh", Ksh)
54                      ,(".bash", Bash)
55                      ,(".bats", Bash)
56                      ,(".dash", Dash)]
57                      -- The `.sh` is too generic to determine the shell:
58                      -- We fallback to Bash in this case and emit SC2148 if there is no shebang
59    candidates =
60        [sh | (ext,sh) <- shellExtensions, ext `isSuffixOf` filename]
61
62checkScript :: Monad m => SystemInterface m -> CheckSpec -> m CheckResult
63checkScript sys spec = do
64    results <- checkScript (csScript spec)
65    return emptyCheckResult {
66        crFilename = csFilename spec,
67        crComments = results
68    }
69  where
70    checkScript contents = do
71        result <- parseScript sys newParseSpec {
72            psFilename = csFilename spec,
73            psScript = contents,
74            psCheckSourced = csCheckSourced spec,
75            psIgnoreRC = csIgnoreRC spec,
76            psShellTypeOverride = csShellTypeOverride spec
77        }
78        let parseMessages = prComments result
79        let tokenPositions = prTokenPositions result
80        let analysisSpec root =
81                as {
82                    asScript = root,
83                    asShellType = csShellTypeOverride spec,
84                    asFallbackShell = shellFromFilename $ csFilename spec,
85                    asCheckSourced = csCheckSourced spec,
86                    asExecutionMode = Executed,
87                    asTokenPositions = tokenPositions,
88                    asOptionalChecks = csOptionalChecks spec
89                } where as = newAnalysisSpec root
90        let analysisMessages =
91                maybe []
92                    (arComments . analyzeScript . analysisSpec)
93                        $ prRoot result
94        let translator = tokenToPosition tokenPositions
95        return . nub . sortMessages . filter shouldInclude $
96            (parseMessages ++ map translator analysisMessages)
97
98    shouldInclude pc =
99            severity <= csMinSeverity spec &&
100            case csIncludedWarnings spec of
101                Nothing -> code `notElem` csExcludedWarnings spec
102                Just includedWarnings -> code `elem` includedWarnings
103        where
104            code     = cCode (pcComment pc)
105            severity = cSeverity (pcComment pc)
106
107    sortMessages = sortOn order
108    order pc =
109        let pos = pcStartPos pc
110            comment = pcComment pc in
111        (posFile pos,
112         posLine pos,
113         posColumn pos,
114         cSeverity comment,
115         cCode comment,
116         cMessage comment)
117    getPosition = pcStartPos
118
119
120getErrors sys spec =
121    sort . map getCode . crComments $
122        runIdentity (checkScript sys spec)
123  where
124    getCode = cCode . pcComment
125
126check = checkWithIncludes []
127
128checkWithSpec includes =
129    getErrors (mockedSystemInterface includes)
130
131checkWithIncludes includes src =
132    checkWithSpec includes emptyCheckSpec {
133        csScript = src,
134        csExcludedWarnings = [2148]
135    }
136
137checkRecursive includes src =
138    checkWithSpec includes emptyCheckSpec {
139        csScript = src,
140        csExcludedWarnings = [2148],
141        csCheckSourced = True
142    }
143
144checkOptionIncludes includes src =
145    checkWithSpec [] emptyCheckSpec {
146        csScript = src,
147        csIncludedWarnings = includes,
148        csCheckSourced = True
149    }
150
151checkWithRc rc = getErrors
152    (mockRcFile rc $ mockedSystemInterface [])
153
154checkWithIncludesAndSourcePath includes mapper = getErrors
155    (mockedSystemInterface includes) {
156        siFindSource = mapper
157    }
158
159checkWithRcIncludesAndSourcePath rc includes mapper = getErrors
160    (mockRcFile rc $ mockedSystemInterface includes) {
161        siFindSource = mapper
162    }
163
164prop_findsParseIssue = check "echo \"$12\"" == [1037]
165
166prop_commentDisablesParseIssue1 =
167    null $ check "#shellcheck disable=SC1037\necho \"$12\""
168prop_commentDisablesParseIssue2 =
169    null $ check "#shellcheck disable=SC1037\n#lol\necho \"$12\""
170
171prop_findsAnalysisIssue =
172    check "echo $1" == [2086]
173prop_commentDisablesAnalysisIssue1 =
174    null $ check "#shellcheck disable=SC2086\necho $1"
175prop_commentDisablesAnalysisIssue2 =
176    null $ check "#shellcheck disable=SC2086\n#lol\necho $1"
177
178prop_optionDisablesIssue1 =
179    null $ getErrors
180                (mockedSystemInterface [])
181                emptyCheckSpec {
182                    csScript = "echo $1",
183                    csExcludedWarnings = [2148, 2086]
184                }
185
186prop_optionDisablesIssue2 =
187    null $ getErrors
188                (mockedSystemInterface [])
189                emptyCheckSpec {
190                    csScript = "echo \"$10\"",
191                    csExcludedWarnings = [2148, 1037]
192                }
193
194prop_wontParseBadShell =
195    [1071] == check "#!/usr/bin/python\ntrue $1\n"
196
197prop_optionDisablesBadShebang =
198    null $ getErrors
199                (mockedSystemInterface [])
200                emptyCheckSpec {
201                    csScript = "#!/usr/bin/python\ntrue\n",
202                    csShellTypeOverride = Just Sh
203                }
204
205prop_annotationDisablesBadShebang =
206    null $ check "#!/usr/bin/python\n# shellcheck shell=sh\ntrue\n"
207
208
209prop_canParseDevNull =
210    null $ check "source /dev/null"
211
212prop_failsWhenNotSourcing =
213    [1091, 2154] == check "source lol; echo \"$bar\""
214
215prop_worksWhenSourcing =
216    null $ checkWithIncludes [("lib", "bar=1")] "source lib; echo \"$bar\""
217
218prop_worksWhenSourcingWithDashDash =
219    null $ checkWithIncludes [("lib", "bar=1")] "source -- lib; echo \"$bar\""
220
221prop_worksWhenDotting =
222    null $ checkWithIncludes [("lib", "bar=1")] ". lib; echo \"$bar\""
223
224-- FIXME: This should really be giving [1093], "recursively sourced"
225prop_noInfiniteSourcing =
226    null $ checkWithIncludes  [("lib", "source lib")] "source lib"
227
228prop_canSourceBadSyntax =
229    [1094, 2086] == checkWithIncludes [("lib", "for f; do")] "source lib; echo $1"
230
231prop_cantSourceDynamic =
232    [1090] == checkWithIncludes [("lib", "")] ". \"$1\""
233
234prop_cantSourceDynamic2 =
235    [1090] == checkWithIncludes [("lib", "")] "source ~/foo"
236
237prop_canStripPrefixAndSource =
238    null $ checkWithIncludes [("./lib", "")] "source \"$MYDIR/lib\""
239
240prop_canStripPrefixAndSource2 =
241    null $ checkWithIncludes [("./utils.sh", "")] "source \"$(dirname \"${BASH_SOURCE[0]}\")/utils.sh\""
242
243prop_canSourceDynamicWhenRedirected =
244    null $ checkWithIncludes [("lib", "")] "#shellcheck source=lib\n. \"$1\""
245
246prop_recursiveAnalysis =
247    [2086] == checkRecursive [("lib", "echo $1")] "source lib"
248
249prop_recursiveParsing =
250    [1037] == checkRecursive [("lib", "echo \"$10\"")] "source lib"
251
252prop_nonRecursiveAnalysis =
253    null $ checkWithIncludes [("lib", "echo $1")] "source lib"
254
255prop_nonRecursiveParsing =
256    null $ checkWithIncludes [("lib", "echo \"$10\"")] "source lib"
257
258prop_sourceDirectiveDoesntFollowFile =
259    null $ checkWithIncludes
260                [("foo", "source bar"), ("bar", "baz=3")]
261                "#shellcheck source=foo\n. \"$1\"; echo \"$baz\""
262
263prop_filewideAnnotationBase = [2086] == check "#!/bin/sh\necho $1"
264prop_filewideAnnotation1 = null $
265    check "#!/bin/sh\n# shellcheck disable=2086\necho $1"
266prop_filewideAnnotation2 = null $
267    check "#!/bin/sh\n# shellcheck disable=2086\ntrue\necho $1"
268prop_filewideAnnotation3 = null $
269    check "#!/bin/sh\n#unrelated\n# shellcheck disable=2086\ntrue\necho $1"
270prop_filewideAnnotation4 = null $
271    check "#!/bin/sh\n# shellcheck disable=2086\n#unrelated\ntrue\necho $1"
272prop_filewideAnnotation5 = null $
273    check "#!/bin/sh\n\n\n\n#shellcheck disable=2086\ntrue\necho $1"
274prop_filewideAnnotation6 = null $
275    check "#shellcheck shell=sh\n#unrelated\n#shellcheck disable=2086\ntrue\necho $1"
276prop_filewideAnnotation7 = null $
277    check "#!/bin/sh\n# shellcheck disable=2086\n#unrelated\ntrue\necho $1"
278
279prop_filewideAnnotationBase2 = [2086, 2181] == check "true\n[ $? == 0 ] && echo $1"
280prop_filewideAnnotation8 = null $
281    check "# Disable $? warning\n#shellcheck disable=SC2181\n# Disable quoting warning\n#shellcheck disable=2086\ntrue\n[ $? == 0 ] && echo $1"
282
283prop_sourcePartOfOriginalScript = -- #1181: -x disabled posix warning for 'source'
284    3046 `elem` checkWithIncludes [("./saywhat.sh", "echo foo")] "#!/bin/sh\nsource ./saywhat.sh"
285
286prop_spinBug1413 = null $ check "fun() {\n# shellcheck disable=SC2188\n> /dev/null\n}\n"
287
288prop_deducesTypeFromExtension = null result
289  where
290    result = checkWithSpec [] emptyCheckSpec {
291        csFilename = "file.ksh",
292        csScript = "(( 3.14 ))"
293    }
294
295prop_deducesTypeFromExtension2 = result == [2079]
296  where
297    result = checkWithSpec [] emptyCheckSpec {
298        csFilename = "file.bash",
299        csScript = "(( 3.14 ))"
300    }
301
302prop_canDisableShebangWarning = null $ result
303  where
304    result = checkWithSpec [] emptyCheckSpec {
305        csFilename = "file.sh",
306        csScript = "#shellcheck disable=SC2148\nfoo"
307    }
308
309prop_canDisableAllWarnings = result == [2086]
310  where
311    result = checkWithSpec [] emptyCheckSpec {
312        csFilename = "file.sh",
313        csScript = "#!/bin/sh\necho $1\n#shellcheck disable=all\necho `echo $1`"
314    }
315
316prop_canDisableParseErrors = null $ result
317  where
318    result = checkWithSpec [] emptyCheckSpec {
319        csFilename = "file.sh",
320        csScript = "#shellcheck disable=SC1073,SC1072,SC2148\n()"
321    }
322
323prop_shExtensionDoesntMatter = result == [2148]
324  where
325    result = checkWithSpec [] emptyCheckSpec {
326        csFilename = "file.sh",
327        csScript = "echo 'hello world'"
328    }
329
330prop_sourcedFileUsesOriginalShellExtension = result == [2079]
331  where
332    result = checkWithSpec [("file.ksh", "(( 3.14 ))")] emptyCheckSpec {
333        csFilename = "file.bash",
334        csScript = "source file.ksh",
335        csCheckSourced = True
336    }
337
338prop_canEnableOptionalsWithSpec = result == [2244]
339  where
340    result = checkWithSpec [] emptyCheckSpec {
341        csFilename = "file.sh",
342        csScript = "#!/bin/sh\n[ \"$1\" ]",
343        csOptionalChecks = ["avoid-nullary-conditions"]
344    }
345
346prop_optionIncludes1 =
347    -- expect 2086, but not included, so nothing reported
348    null $ checkOptionIncludes (Just [2080]) "#!/bin/sh\n var='a b'\n echo $var"
349
350prop_optionIncludes2 =
351    -- expect 2086, included, so it is reported
352    [2086] == checkOptionIncludes (Just [2086]) "#!/bin/sh\n var='a b'\n echo $var"
353
354prop_optionIncludes3 =
355    -- expect 2086, no inclusions provided, so it is reported
356    [2086] == checkOptionIncludes Nothing "#!/bin/sh\n var='a b'\n echo $var"
357
358prop_optionIncludes4 =
359    -- expect 2086 & 2154, only 2154 included, so only that's reported
360    [2154] == checkOptionIncludes (Just [2154]) "#!/bin/sh\n var='a b'\n echo $var\n echo $bar"
361
362
363prop_readsRcFile = null result
364  where
365    result = checkWithRc "disable=2086" emptyCheckSpec {
366        csScript = "#!/bin/sh\necho $1",
367        csIgnoreRC = False
368    }
369
370prop_canUseNoRC = result == [2086]
371  where
372    result = checkWithRc "disable=2086" emptyCheckSpec {
373        csScript = "#!/bin/sh\necho $1",
374        csIgnoreRC = True
375    }
376
377prop_NoRCWontLookAtFile = result == [2086]
378  where
379    result = checkWithRc (error "Fail") emptyCheckSpec {
380        csScript = "#!/bin/sh\necho $1",
381        csIgnoreRC = True
382    }
383
384prop_brokenRcGetsWarning = result == [1134, 2086]
385  where
386    result = checkWithRc "rofl" emptyCheckSpec {
387        csScript = "#!/bin/sh\necho $1",
388        csIgnoreRC = False
389    }
390
391prop_canEnableOptionalsWithRc = result == [2244]
392  where
393    result = checkWithRc "enable=avoid-nullary-conditions" emptyCheckSpec {
394        csScript = "#!/bin/sh\n[ \"$1\" ]"
395    }
396
397prop_sourcePathRedirectsName = result == [2086]
398  where
399    f "dir/myscript" _ _ "lib" = return "foo/lib"
400    result = checkWithIncludesAndSourcePath [("foo/lib", "echo $1")] f emptyCheckSpec {
401        csScript = "#!/bin/bash\nsource lib",
402        csFilename = "dir/myscript",
403        csCheckSourced = True
404    }
405
406prop_sourcePathAddsAnnotation = result == [2086]
407  where
408    f "dir/myscript" _ ["mypath"] "lib" = return "foo/lib"
409    result = checkWithIncludesAndSourcePath [("foo/lib", "echo $1")] f emptyCheckSpec {
410        csScript = "#!/bin/bash\n# shellcheck source-path=mypath\nsource lib",
411        csFilename = "dir/myscript",
412        csCheckSourced = True
413    }
414
415prop_sourcePathRedirectsDirective = result == [2086]
416  where
417    f "dir/myscript" _ _ "lib" = return "foo/lib"
418    f _ _ _ _ = return "/dev/null"
419    result = checkWithIncludesAndSourcePath [("foo/lib", "echo $1")] f emptyCheckSpec {
420        csScript = "#!/bin/bash\n# shellcheck source=lib\nsource kittens",
421        csFilename = "dir/myscript",
422        csCheckSourced = True
423    }
424
425prop_rcCanAllowExternalSources = result == [2086]
426  where
427    f "dir/myscript" (Just True) _ "mylib" = return "resolved/mylib"
428    f a b c d = error $ show ("Unexpected", a, b, c, d)
429    result = checkWithRcIncludesAndSourcePath "external-sources=true" [("resolved/mylib", "echo $1")] f emptyCheckSpec {
430        csScript = "#!/bin/bash\nsource mylib",
431        csFilename = "dir/myscript",
432        csCheckSourced = True
433    }
434
435prop_rcCanDenyExternalSources = result == [2086]
436  where
437    f "dir/myscript" (Just False) _ "mylib" = return "resolved/mylib"
438    f a b c d = error $ show ("Unexpected", a, b, c, d)
439    result = checkWithRcIncludesAndSourcePath "external-sources=false" [("resolved/mylib", "echo $1")] f emptyCheckSpec {
440        csScript = "#!/bin/bash\nsource mylib",
441        csFilename = "dir/myscript",
442        csCheckSourced = True
443    }
444
445prop_rcCanLeaveExternalSourcesUnspecified = result == [2086]
446  where
447    f "dir/myscript" Nothing _ "mylib" = return "resolved/mylib"
448    f a b c d = error $ show ("Unexpected", a, b, c, d)
449    result = checkWithRcIncludesAndSourcePath "" [("resolved/mylib", "echo $1")] f emptyCheckSpec {
450        csScript = "#!/bin/bash\nsource mylib",
451        csFilename = "dir/myscript",
452        csCheckSourced = True
453    }
454
455prop_fileCanDisableExternalSources = result == [2006, 2086]
456  where
457    f "dir/myscript" (Just True) _ "withExternal" = return "withExternal"
458    f "dir/myscript" (Just False) _ "withoutExternal" = return "withoutExternal"
459    f a b c d = error $ show ("Unexpected", a, b, c, d)
460    result = checkWithRcIncludesAndSourcePath "external-sources=true" [("withExternal", "echo $1"), ("withoutExternal", "_=`foo`")] f emptyCheckSpec {
461        csScript = "#!/bin/bash\ntrue\nsource withExternal\n# shellcheck external-sources=false\nsource withoutExternal",
462        csFilename = "dir/myscript",
463        csCheckSourced = True
464    }
465
466prop_fileCannotEnableExternalSources = result == [1144]
467  where
468    f "dir/myscript" Nothing _ "foo" = return "foo"
469    f a b c d = error $ show ("Unexpected", a, b, c, d)
470    result = checkWithRcIncludesAndSourcePath "" [("foo", "true")] f emptyCheckSpec {
471        csScript = "#!/bin/bash\n# shellcheck external-sources=true\nsource foo",
472        csFilename = "dir/myscript",
473        csCheckSourced = True
474    }
475
476prop_fileCannotEnableExternalSources2 = result == [1144]
477  where
478    f "dir/myscript" (Just False) _ "foo" = return "foo"
479    f a b c d = error $ show ("Unexpected", a, b, c, d)
480    result = checkWithRcIncludesAndSourcePath "external-sources=false" [("foo", "true")] f emptyCheckSpec {
481        csScript = "#!/bin/bash\n# shellcheck external-sources=true\nsource foo",
482        csFilename = "dir/myscript",
483        csCheckSourced = True
484    }
485
486
487return []
488runTests = $quickCheckAll
489