1 # scripts -- lintian check script -*- perl -*-
3 # This is probably the right file to add a check for the use of
4 # set -e in bash and sh scripts.
6 # Copyright (C) 1998 Richard Braakman
7 # Copyright (C) 2002 Josip Rodin
9 # This program is free software; you can redistribute it and/or modify
10 # it under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 2 of the License, or
12 # (at your option) any later version.
14 # This program is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with this program. If not, you can find it on the World Wide
21 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
22 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
25 package Lintian::scripts;
31 # This is a map of all known interpreters. The key is the interpreter name
32 # (the binary invoked on the #! line). The value is an anonymous array of one
33 # or two elements. The first, mandatory argument is the path on a Debian
34 # system where that interpreter would be installed. The second, optional
35 # argument is the dependency that provides that interpreter. If the second
36 # argument isn't given, the package name is assumed to be the same as the
37 # interpreter name. (Saves some typing.)
39 # Some interpreters list empty dependencies (as opposed to undefined ones).
40 # Those interpreters should not have any dependency for one reason or another
41 # (usually because they're essential packages or aren't used in a normal way).
43 # Do not list versioned patterns here (such as pythonX.Y, rubyX.Y, etc.). For
44 # those, see %versioned_interpreters below.
47 awk => [ '/usr/bin', '' ],
48 bash => [ '/bin', '' ],
49 bltwish => [ '/usr/bin', 'blt' ],
50 clisp => [ '/usr/bin' ],
51 csh => [ '/bin', 'tcsh | csh | c-shell' ],
53 expect => [ '/usr/bin' ],
54 expectk => [ '/usr/bin' ],
55 fish => [ '/usr/bin' ],
56 gawk => [ '/usr/bin' ],
57 gbr2 => [ '/usr/bin', 'gambas2-runtime' ],
58 gbx => [ '/usr/bin', 'gambas-runtime' ],
59 gbx2 => [ '/usr/bin', 'gambas2-runtime' ],
60 gforth => [ '/usr/bin' ],
61 gnuplot => [ '/usr/bin' ],
62 gosh => [ '/usr/bin', 'gauche' ],
63 'install-menu' => [ '/usr/bin', '' ],
64 jed => [ '/usr/bin' ],
65 'jed-script' => [ '/usr/bin', 'jed | xjed' ],
66 kaptain => [ '/usr/bin' ],
67 ksh => [ '/bin', 'mksh | pdksh' ],
68 lefty => [ '/usr/bin', 'graphviz' ],
69 magicfilter => [ '/usr/sbin' ],
70 make => [ '/usr/bin', 'make | build-essential' ],
71 mawk => [ '/usr/bin' ],
72 ocamlrun => [ '/usr/bin',
73 'ocaml-base-nox | ocaml-base | ocaml-nox | ocaml' ],
74 pagsh => [ '/usr/bin', 'openafs-client | heimdal-clients' ],
75 parrot => [ '/usr/bin' ],
76 perl => [ '/usr/bin', '' ],
77 procmail => [ '/usr/bin' ],
78 python => [ '/usr/bin', 'python | python-minimal' ],
79 pforth => [ '/usr/bin' ],
81 regina => [ '/usr/bin', 'regina-rexx' ],
82 rexx => [ '/usr/bin', 'regina-rexx' ],
83 rrdcgi => [ '/usr/bin', 'rrdtool' ],
84 ruby => [ '/usr/bin' ],
85 runhugs => [ '/usr/bin', 'hugs | hugs98' ],
86 sed => [ '/bin', '' ],
88 slsh => [ '/usr/bin' ],
89 speedy => [ '/usr/bin', 'speedy-cgi-perl' ],
90 tcsh => [ '/usr/bin' ],
91 tixwish => [ '/usr/bin', 'tix' ],
92 trs => [ '/usr/bin', 'konwert' ],
93 xjed => [ '/usr/bin', 'xjed' ],
94 yforth => [ '/usr/bin', 'yforth' ],
95 yorick => [ '/usr/bin' ],
96 zsh => [ '/bin', 'zsh | zsh-beta' ],
99 # The more complex case of interpreters that may have a version number.
101 # This is a hash from the base interpreter name to a list. The base
102 # interpreter name may appear by itself or followed by some combination of
103 # dashes, digits, and periods. The values are the directory in which the
104 # interpreter is found, the dependency to add for a version-less interpreter,
105 # a regular expression to match versioned interpreters and extract the version
106 # number, the package dependency for a versioned interpreter, and the list of
109 # An interpreter with a version must have a dependency on the specific package
110 # formed by taking the fourth element of the list and replacing $1 with the
111 # version number. An interpreter without a version is rejected if the second
112 # element is undef; otherwise, the package must depend on the disjunction of
113 # the second argument (if non-empty) and all the packages formed by taking the
114 # list of known versions (the fifth element and on) and replacing $1 in the
115 # fourth argument with them.
119 # lua => [ '/usr/bin', 'lua', qr/^lua([\d.]+)$/, 'lua$1', qw(40 50 5.1) ]
121 # says that any lua interpreter must be in /usr/bin, a package using
122 # /usr/bin/lua50 must depend on lua50, and a package using just /usr/bin/lua
123 # must satisfy lua | lua40 | lusa50 | lua5.1.
125 # The list of known versions is the largest maintenance headache here, but
126 # it's only used for the unversioned dependency handling, and then only when
127 # someone uses the unversioned script but depends on a specific version for
128 # some reason. So it's not a huge problem if it's a little out of date.
129 our %versioned_interpreters =
130 (guile => [ '/usr/bin', 'guile',
131 qr/^guile-([\d.]+)$/, 'guile-$1', qw(1.6 1.8)
133 jruby => [ '/usr/bin', undef,
134 qr/^jruby([\d.]+)$/, 'jruby$1', qw(0.9 1.0)
136 lua => [ '/usr/bin', 'lua',
137 qr/^lua([\d.]+)$/, 'lua$1', qw(40 50 5.1)
139 octave => [ '/usr/bin', 'octave',
140 qr/^octave([\d.]+)$/, 'octave$1', qw(2.1 2.9 3.0)
142 php => [ '/usr/bin', '',
143 qr/^php(\d+)$/, 'php$1-cli', qw(4 5)
145 pike => [ '/usr/bin', '',
146 qr/^pike([\d.]+)$/, 'pike$1 | pike$1-core', qw(7.6 7.7)
148 python => [ '/usr/bin', undef,
149 qr/^python([\d.]+)$/, 'python$1 | python$1-minimal',
152 ruby => [ '/usr/bin', undef,
153 qr/^ruby([\d.]+)$/, 'ruby$1', qw(1.8 1.9)
155 scsh => [ '/usr/bin', 'scsh',
156 qr/^scsh-([\d.]+)$/, 'scsh-$1', qw(0.6)
158 tclsh => [ '/usr/bin', 'tclsh | tcl',
159 qr/^tclsh([\d.]+)$/, 'tcl$1', qw(8.3 8.4 8.5)
161 wish => [ '/usr/bin', 'wish | tk',
162 qr/^wish([\d.]+)$/, 'tk$1', qw(8.3 8.4 8.5)
166 # Any of the following packages can satisfy an update-inetd dependency.
168 = join (' | ', qw(update-inetd inet-superserver openbsd-inetd
169 inetutils-inetd rlinetd xinetd));
171 # Appearance of one of these regexes in a maintainer script means that there
172 # must be a dependency (or pre-dependency) on the given package. The tag
173 # reported is maintainer-script-needs-depends-on-%s, so be sure to update
174 # scripts.desc when adding a new rule.
175 our @depends_needed = (
176 [ adduser => '\badduser\b' ],
177 [ gconf2 => '\bgconf-schemas\b' ],
178 [ $update_inetd => '\bupdate-inetd\b' ],
179 [ ucf => '\bucf\s' ],
180 [ 'xml-core' => '\bupdate-xmlcatalog\b' ],
191 # no dependency for install-menu, because the menu package specifically
192 # says not to depend on it.
197 open(INDEX, '<', "index") or fail("cannot open lintian index file: $!");
199 next unless (m/^-[rw-]*[xs]/);
202 my $is_suid = m/^-[rw-]*s/;
203 $executable{(split(' ', $_, 6))[5]} = 1;
204 $suid{(split(' ', $_, 6))[5]} = $is_suid;
208 # Urgle... this is ambiguous, since the sequence ": " can occur in
209 # the output of file and also in the filename.
210 # Fortunately no filenames containing ": " currently occur in Debian packages.
211 open(FILEINFO, '<', "file-info")
212 or fail("cannot open lintian file-info file: $!");
214 m/^(.*?): (.*)/ or fail("bad line in file-info: $_");
216 $ELF{$file} = 1 if $2 =~ /^[^,]*\bELF\b/o;
221 for my $field (qw/suggests recommends depends pre-depends provides/) {
223 if (open(IN, '<', "fields/$field")) {
228 $all_deps .= ', ' if $all_deps;
231 $deps{$field} = Dep::parse($deps{$field});
233 $all_deps .= ', ' if $all_deps;
235 $deps{all} = Dep::parse($all_deps);
237 open(SCRIPTS, '<', "scripts") or fail("cannot open lintian scripts file: $!");
241 # This used to be split(' ', $_, 2), but that didn't handle empty
242 # interpreter lines correctly.
243 my ($calls_env, $interpreter, $filename) = m/^(env )?(\S*) (.*)$/ or
244 fail("bad line in scripts file: $_");
246 $scripts{$filename} = 1;
248 # no checks necessary at all for scripts in /usr/share/doc/
249 next if $filename =~ m,usr/share/doc/,;
251 my ($base) = $interpreter =~ m,([^/]*)$,;
253 # allow exception for .in files that have stuff like #!@PERL@
254 next if ($filename =~ m,\.in$, and $interpreter =~ m,^(\@|<\<)[A-Z_]+(\@|>\>)$,);
256 my $is_absolute = ($interpreter =~ m,^/, or defined $calls_env);
258 # Skip files that have the #! line, but are not executable and do not have
259 # an absolute path and are not in a bin/ directory (/usr/bin, /bin etc)
260 # They are probably not scripts after all.
261 next if ($filename !~ m,(bin/|etc/init.d/), and !$executable{$filename}
264 if ($interpreter eq "") {
265 tag("script-without-interpreter", $filename);
269 # Either they use an absolute path or they use '/usr/bin/env interp'.
270 tag("interpreter-not-absolute", $filename, "#!$interpreter")
272 tag("script-not-executable", $filename)
273 unless ($executable{$filename}
274 or $filename =~ m,^\./usr/(lib|share)/.*\.pm,
275 or $filename =~ m,^\./usr/(lib|share)/.*\.py,
276 or $filename =~ m,^\./usr/(lib|share)/ruby/.*\.rb,
277 or $filename =~ m,\.in$,
278 or $filename =~ m,\.ex$,
279 or $filename eq './etc/init.d/skeleton'
280 or $filename =~ m,^\./etc/menu-methods,
281 or $filename =~ m,^\./etc/X11/Xsession.d,);
283 # Warn about csh scripts.
284 tag("csh-considered-harmful", $filename)
285 if (($base eq 'csh' or $base eq 'tcsh')
286 and $executable{$filename}
287 and $filename !~ m,^./etc/csh/login.d/,);
289 # Syntax-check most shell scripts, but don't syntax-check scripts that end
290 # in .dpatch. bash -n doesn't stop checking at exit 0 and goes on to blow
291 # up on the patch itself.
292 # zsh -n is broken, see #485885
293 if ($base =~ /^(?:(?:b|d)?a|k)?sh$/) {
294 if (-x "$interpreter" && ! script_is_evil_and_wrong("unpacked/$filename")) {
295 if ($filename !~ m,\.dpatch$,) {
296 if (check_script_syntax($interpreter, "unpacked/$filename")) {
297 tag("shell-script-fails-syntax-check", $filename);
303 # Try to find the expected path of the script to check. First check
304 # %interpreters and %versioned_interpreters. If not found there, see if
305 # it ends in a version number and the base is found in
306 # %versioned_interpreters.
307 my $data = $interpreters{$base};
309 if (not defined $data) {
310 $data = $versioned_interpreters{$base};
311 undef $data if ($data and not defined ($data->[1]));
312 if (not defined ($data) and $base =~ /^(.*[^\d.-])-?[\d.]+$/) {
313 $data = $versioned_interpreters{$1};
314 undef $data unless ($data and $base =~ /$data->[2]/);
316 $versioned = 1 if $data;
319 my $expected = $data->[0] . '/' . $base;
320 unless ($interpreter eq $expected or defined $calls_env) {
321 tag("wrong-path-for-interpreter",
322 "#!$interpreter != $expected", "($filename)");
324 } elsif ($interpreter =~ m,/usr/local/,) {
325 tag("interpreter-in-usr-local", $filename, "#!$interpreter");
326 } elsif ($executable{'.' . $interpreter}) {
327 # Package installs the interpreter itself, so it's probably ok. Don't
328 # emit any tag for this.
329 } elsif ($base eq 'suidperl') {
330 tag("calls-suidperl-directly", $filename);
331 } elsif ($interpreter eq '/bin/env') {
332 tag("script-uses-bin-env", $filename);
334 tag("unusual-interpreter", $filename, "#!$interpreter");
337 # If we found the interpreter and the script is executable, check
338 # dependencies. This should be the last thing we do in the loop so that
339 # we can use next for an early exit and reduce the nesting.
340 next unless ($data && $executable{$filename});
342 my $depends = $data->[1];
343 if (not defined $depends) {
346 if ($depends && !Dep::implies($deps{all}, Dep::parse($depends))) {
347 if ($base =~ /^(python|ruby|(m|g)awk)$/) {
348 tag("$base-script-but-no-$base-dep", $filename);
349 } elsif ($base eq 'csh' && $filename =~ m,^\./etc/csh/login.d/,) {
350 # Initialization files for csh.
351 } elsif ($base eq 'fish' && $filename =~ m,^./etc/fish.d/,) {
352 # Initialization files for fish.
354 tag('missing-dep-for-interpreter', "$base => $depends",
358 if ($base eq 'perl' && $suid{$filename}) {
359 tag("suid-perl-script-but-no-perl-suid-dep", $filename)
360 unless Dep::implies($deps{all}, Dep::parse('perl-suid'));
362 } elsif ($versioned_interpreters{$base}) {
363 my @versions = @$data[4 .. @$data - 1];
369 my $depends = join (' | ', $data->[1], @depends);
370 unless (Dep::implies($deps{all}, Dep::parse($depends))) {
371 if ($base eq 'php') {
372 tag('php-script-but-no-phpX-cli-dep', $filename);
373 } elsif ($base =~ /^(wish|tclsh)/) {
374 tag("$1-script-but-no-$1-dep", $filename);
376 tag("missing-dep-for-interpreter", "$base => $depends",
381 my ($version) = ($base =~ /$data->[2]/);
382 my $depends = $data->[3];
383 $depends =~ s/\$1/$version/g;
384 unless (Dep::implies($deps{all}, Dep::parse($depends))) {
385 if ($base =~ /^php/) {
386 tag('php-script-but-no-phpX-cli-dep', $filename);
387 } elsif ($base =~ /^(python|ruby)/) {
388 tag("$1-script-but-no-$1-dep", $filename);
390 tag("missing-dep-for-interpreter", "$base => $depends",
398 foreach (keys %executable) {
399 tag("executable-not-elf-or-script", $_)
402 or $_ =~ m,^usr(/X11R6)?/man/,
403 or $_ =~ m/\.exe$/ # mono convention
407 open(SCRIPTS, '<', "control-scripts")
408 or fail("cannot open lintian control-scripts file: $!");
410 # Handle control scripts. This is an edited version of the code for
411 # normal scripts above, because there were just enough differences to
412 # make a shared function awkward.
417 m/^(\S*) (.*)$/ or fail("bad line in control-scripts file: $_");
418 my $interpreter = $1;
420 my $filename = "control/$file";
422 $interpreter =~ m|([^/]*)$|;
425 if ($interpreter eq "") {
426 tag("script-without-interpreter", $filename);
430 tag("interpreter-not-absolute", $filename, "#!$interpreter")
431 unless ($interpreter =~ m|^/|);
433 if (exists $interpreters{$base}) {
434 my $data = $interpreters{$base};
435 my $expected = $data->[0] . '/' . $base;
436 tag("wrong-path-for-interpreter", "#!$interpreter != $expected",
438 unless ($interpreter eq $expected);
439 unless ($base eq 'sh' or $base eq 'bash' or $base eq 'perl') {
441 if ($file eq 'config') {
442 $tag = 'forbidden-config-interpreter';
444 $tag = 'unusual-control-interpreter';
446 tag($tag, "#!$interpreter");
448 unless (defined ($data->[1]) and not $data->[1]) {
449 my $depends = $data->[1] || $base;
450 unless (Dep::implies($deps{'pre-depends'}, Dep::parse($depends))) {
451 tag("interpreter-without-predep", $filename, "#!$interpreter");
454 } elsif ($interpreter =~ m|/usr/local/|) {
455 tag("interpreter-in-usr-local", $filename, "#!$interpreter");
457 tag("unusual-interpreter", $filename, "#!$interpreter");
458 next; # no use doing further checks if it's not a known interpreter
461 # perhaps we should warn about *csh even if they're somehow screwed,
462 # but that's not really important...
463 tag("csh-considered-harmful", $filename)
464 if ($base eq 'csh' or $base eq 'tcsh');
466 my $shellscript = $base =~ /^((b|d)?a|t?c|(pd)?k)?sh$/ ? 1 : 0;
468 # Only syntax-check scripts we can check with bash.
471 $checkbashisms = $base eq "sh" ? 1 : 0;
472 if ($base eq 'sh' or $base eq 'bash') {
473 if (check_script_syntax("/bin/bash", $filename)) {
474 tag("maintainer-shell-script-fails-syntax-check", $file);
479 # now scan the file contents themselves
480 open (C, '<', "$filename")
481 or fail("cannot open maintainer script $filename for reading: $!");
484 my ($saw_init, $saw_invoke, $saw_debconf, $has_code);
488 next if m,^\s*$,; # skip empty lines
489 next if m,^\s*\#,; # skip comment lines
490 s/\#.*$//; # eat comments
493 # Don't consider the standard dh-make boilerplate to be code. This
494 # means ignoring the framework of a case statement, the labels, the
495 # echo complaining about unknown arguments, and an exit.
497 || m/^\s*set\s+-\w+\s*$/
498 || m/^\s*case\s+\"?\$1\"?\s+in\s*$/
499 || m/^\s*(?:[a-z|-]+|\*)\)\s*$/
501 || m/^\s*echo\s+\"[^\"]+\"(?:\s*>&2)?\s*$/
503 || m/^\s*exit\s+\d+\s*$/) {
507 if (m,[^\w=](/var)?/tmp\b, and not m/\bmktemp\b/ and not m/\btempfile\b/ and not m/\bmkdir\b/ and not m/\bmkstemp\b/) {
508 tag "possibly-insecure-handling-of-tmp-files-in-maintainer-script", "$file:$."
512 if (m/^\s*killall(?:\s|\z)/) {
513 tag "killall-is-dangerous", "$file:$." unless $warned{killall};
514 $warned{killall} = 1;
516 if (m/^\s*mknod(?:\s|\z)/ and not m/\sp\s/) {
517 tag "mknod-in-maintainer-script", "$file:$.";
520 # Collect information about init script invocations to catch running
521 # init scripts directory rather than through invoke-rc.d. Since the
522 # script is allowed to run the init script directly if invoke-rc.d
523 # doesn't exist, only tag direct invocations where invoke-rc.d is
524 # never used in the same script. Lots of false negatives, but
525 # hopefully not many false positives.
526 if (m%^\s*/etc/init.d/(\S+)\s+[\"\']?(\S+)[\"\']?%) {
529 if (m%^\s*invoke-rc.d\s+%) {
534 if ($cat_string ne "" and m/^\Q$cat_string\E$/) {
537 my $within_another_shell = 0;
538 if (m,(^|\s+)((/usr)?/bin/)?((b|d)?a|k|z|t?c)sh\s+-c\s*.+,) {
539 $within_another_shell = 1;
541 # if cat_string is set, we are in a HERE document and need not
543 if ($cat_string eq "" and $checkbashisms and !$within_another_shell) {
546 my $LEADIN = qr'(?:(^|[`&;(|{])\s*|(if|then|do|while)\s+)';
547 my @bashism_single_quote_regexs = (
548 $LEADIN . qr'echo\s+(?:-[^e\s]+\s+)?\'[^\']*(\\[\\abcEfnrtv0])+.*?[\']',
549 # unsafe echo with backslashes
551 my @bashism_string_regexs = (
552 qr'\$\[\w+\]', # arith not allowed
553 qr'\$\{\w+\:\d+(?::\d+)?\}', # ${foo:3[:1]}
554 qr'\$\{\w+(/.+?){1,2}\}', # ${parm/?/pat[/str]}
555 qr'\$\{\#?\w+\[[0-9\*\@]+\]\}',# bash arrays, ${name[0|*|@]}
556 qr'\$\{!\w+[\@*]\}', # ${!prefix[*|@]}
557 qr'\$\{!\w+\}', # ${!name}
558 qr'(\$\(|\`)\s*\<\s*\S+\s*(\)|\`)', # $(\< foo) should be $(cat foo)
559 qr'\$\{?RANDOM\}?\b', # $RANDOM
560 qr'\$\{?(OS|MACH)TYPE\}?\b', # $(OS|MACH)TYPE
561 qr'\$\{?HOST(TYPE|NAME)\}?\b', # $HOST(TYPE|NAME)
562 qr'\$\{?DIRSTACK\}?\b', # $DIRSTACK
563 qr'\$\{?EUID\}?\b', # $EUID should be "id -u"
564 qr'\$\{?UID\}?\b', # $UID should be "id -ru"
565 qr'\$\{?SECONDS\}?\b', # $SECONDS
566 qr'\$\{?BASH_[A-Z]+\}?\b', # $BASH_SOMETHING
567 qr'\$\{?SHELLOPTS\}?\b', # $SHELLOPTS
568 qr'\$\{?PIPESTATUS\}?\b', # $PIPESTATUS
569 qr'\$\{?SHLVL\}?\b', # $SHLVL
570 qr'<<<', # <<< here string
571 $LEADIN . qr'echo\s+(?:-[^e\s]+\s+)?\"[^\"]*(\\[\\abcEfnrtv0])+.*?[\"]',
572 # unsafe echo with backslashes
574 my @bashism_regexs = (
575 qr'(?:^|\s+)function \w+(\s|\(|\Z)', # function is useless
576 # should be '.', not 'source'
577 $LEADIN . qr'source\s+(?:\.\/|\/|\$)[^\s]+',
578 qr'(test|-o|-a)\s*[^\s]+\s+==\s', # should be 'b = a'
579 qr'\[\s+[^\]]+\s+==\s', # should be 'b = a'
580 qr'\s(\|\&)', # pipelining is not POSIX
581 qr'[^\\\$]\{(?:[^\s\\\}]+?,)+[^\\\}\s]+\}', # brace expansion
582 qr'(?:^|\s+)\w+\[\d+\]=', # bash arrays, H[0]
583 $LEADIN . qr'(read\s*(-[^r]+)*(?:;|$))',
584 # read without variable or with option other than -r
585 $LEADIN . qr'kill\s+-[^sl]\w*',# kill -[0-9] or -[A-Z]
586 $LEADIN . qr'trap\s+["\']?.*["\']?\s+.*[1-9]', # trap with signal numbers
588 qr'(<\&|>\&)\s*((-|\d+)[^\s;|)`&\\\\]|[^-\d\s]+)', # should be >word 2>&1
589 qr'\[\[(?!:)', # alternative test command
590 $LEADIN . qr'select\s+\w+', # 'select' is not POSIX
591 $LEADIN . qr'echo\s+(-n\s+)?-n?en?', # echo -e
592 $LEADIN . qr'exec\s+-[acl]', # exec -c/-l/-a name
593 qr'(?:^|\s+)let\s', # let ...
594 qr'(?<![\$\(])\(\(.*\)\)', # '((' should be '$(('
595 qr'\$\[[^][]+\]', # '$[' should be '$(('
596 qr'(\[|test)\s+-a', # test with unary -a (should be -e)
597 qr'/dev/(tcp|udp)', # /dev/(tcp|udp)
598 $LEADIN . qr'\w+\+=', # should be "VAR="${VAR}foo"
599 $LEADIN . qr'suspend\s',
600 $LEADIN . qr'caller\s',
601 $LEADIN . qr'complete\s',
602 $LEADIN . qr'compgen\s',
603 $LEADIN . qr'declare\s',
604 $LEADIN . qr'typeset\s',
605 $LEADIN . qr'disown\s',
606 $LEADIN . qr'builtin\s',
607 $LEADIN . qr'set\s+-[BHT]+', # set -[BHT]
608 $LEADIN . qr'alias\s+-p', # alias -p
609 $LEADIN . qr'unalias\s+-a', # unalias -a
610 $LEADIN . qr'local\s+-[a-zA-Z]+', # local -opt
611 $LEADIN . qr'local\s+\w+=', # local foo=bar
612 qr'(?:^|\s+)\s*\(?\w*[^\(\w\s]+\S*?\s*\(\)\s*([\{|\(]|\Z)',
613 # function names should only contain [a-z0-9_]
614 $LEADIN . qr'(push|pop)d(\s|\Z)', # (push|pod)d
615 $LEADIN . qr'export\s+-[^p]', # export only takes -p as an option
616 $LEADIN . qr'ulimit(\s|\Z)',
617 $LEADIN . qr'shopt(\s|\Z)',
618 $LEADIN . qr'type\s',
619 $LEADIN . qr'time\s',
620 $LEADIN . qr'dirs(\s|\Z)',
621 qr'(?:^|\s+)[<>]\(.*?\)', # <() process substituion
622 qr'(?:^|\s+)readonly\s+-[af]', # readonly -[af]
623 $LEADIN . qr'(sh|\$\{?SHELL\}?) -[rD]', # sh -[rD]
624 $LEADIN . qr'(sh|\$\{?SHELL\}?) --\w+', # sh --long-option
625 $LEADIN . qr'(sh|\$\{?SHELL\}?) [-+]O', # sh [-+]O
628 # since this test is ugly, I have to do it by itself
629 # detect source (.) trying to pass args to the command it runs
630 # The first expression weeds out '. "foo bar"'
632 not m/^\s*\.\s+(\"[^\"]+\"|\'[^\']+\')\s*(\&|\||\d?>|<|;|\Z)/
633 and m/^\s*(\.\s+[^\s;\`:]+\s+([^\s;]+))/) {
636 ($match, $extra) = ($1, $2);
637 if ($extra =~ /^(\&|\||\d?>|<)/) {
648 for my $re (@bashism_single_quote_regexs) {
649 if ($line =~ m/($re)/) {
657 # Ignore anything inside single quotes; it could be an
658 # argument to grep or the like.
660 # $cat_line contains the version of the line we'll check
661 # for heredoc delimiters later. Initially, remove any
662 # spaces between << and the delimiter to make the following
663 # updates to $cat_line easier.
664 my $cat_line = $line;
665 $cat_line =~ s/(<\<-?)\s+/$1/g;
667 # Remove single quoted strings, with the exception that we
668 # don't remove the string
669 # if the quote is immediately preceeded by a < or a -, so we
670 # can match "foo <<-?'xyz'" as a heredoc later
671 # The check is a little more greedy than we'd like, but the
672 # heredoc test itself will weed out any false positives
673 $cat_line =~ s/(^|[^<\\\"-](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g;
676 # Remove "quoted quotes". They're likely to be inside
677 # another pair of quotes; we're not interested in
678 # them for their own sake and removing them makes finding
679 # the limits of the outer pair far easier.
680 $line =~ s/(^|[^\\\'\"])\"\'\"/$1/g;
681 $line =~ s/(^|[^\\\'\"])\'\"\'/$1/g;
683 $line =~ s/(^|[^\\\"](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g;
684 for my $re (@bashism_string_regexs) {
685 if ($line =~ m/($re)/) {
693 # We've checked for all the things we still want to notice in
694 # double-quoted strings, so now remove those strings as well.
695 $cat_line =~ s/(^|[^<\\\'-](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g;
697 $line =~ s/(^|[^\\\'](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g;
698 for my $re (@bashism_regexs) {
699 if ($line =~ m/($re)/) {
708 tag "possible-bashism-in-maintainer-script", "$file:$. \'$match\'";
711 # Only look for the beginning of a heredoc here, after we've
712 # stripped out quoted material, to avoid false positives.
713 if ($cat_line =~ m/(?:^|[^<])\<\<\-?\s*(?:[\\]?(\w+)|[\'\"](.*?)[\'\"])/) {
715 $cat_string = $2 if not defined $cat_string;
719 if (/^\s*start-stop-daemon\s+/ && !/\s--stop\b/) {
720 tag 'start-stop-daemon-in-maintainer-script', "$file:$.";
722 # Don't use chown foo.bar
723 if (/(chown(\s+--?[A-Za-z-]+)*\s+[-_A-Za-z0-9]+\.[-_A-Za-z0-9]+)\s+/) {
724 tag "deprecated-chown-usage", "$file:$. \'$1\'";
726 if (/invoke-rc.d.*\|\| exit 0/) {
727 tag "maintainer-script-hides-init-failure", "$file:$.";
729 if (m,/usr/share/debconf/confmodule,) {
732 if (m/^\s*read(?:\s|\z)/ && !$saw_debconf) {
733 tag "read-in-maintainer-script", "$file:$.";
735 if (m,^\s*rm\s+([^>]*\s)?/dev/,) {
736 tag "maintainer-script-removes-device-files", "$file:$.";
738 if (m,>\s*(/etc/(?:services|protocols|rpc))(\s|\Z),) {
739 tag "maintainer-script-modifies-netbase-managed-file", "$file:$. $1";
741 if (m,^\s*(?:cp|mv)\s.*(/etc/(?:services|protocols|rpc))\s*$,) {
742 tag "maintainer-script-modifies-netbase-managed-file", "$file:$. $1";
744 if (m,>\s*/etc/inetd\.conf(\s|\Z),) {
745 tag "maintainer-script-modifies-inetd-conf", "$file:$."
746 unless Dep::implies($deps{provides}, Dep::parse('inet-superserver'));
748 if (m,^\s*(?:cp|mv)\s+(?:.*\s)?/etc/inetd\.conf\s*$,) {
749 tag "maintainer-script-modifies-inetd-conf", "$file:$."
750 unless Dep::implies($deps{provides}, Dep::parse('inet-superserver'));
753 # Ancient dpkg feature tests.
754 if (m/^\s*dpkg\s+--assert-support-predepends\b/) {
755 tag "ancient-dpkg-predepends-check", "$file:$.";
757 if (m/^\s*dpkg\s+--assert-working-epoch\b/) {
758 tag "ancient-dpkg-epoch-check", "$file:$.";
760 if (m/^dpkg\s+--assert-long-filenames\b/) {
761 tag "ancient-dpkg-long-filenames-check", "$file:$.";
763 if (m/^dpkg\s+--assert-multi-conrep\b/) {
764 tag "ancient-dpkg-multi-conrep-check", "$file:$.";
768 if (m,\bsuidregister\b,) {
769 tag "suidregister-used-in-maintainer-script", "$file";
771 if ($file eq 'postrm') {
772 if (m,update\-alternatives \-\-remove,) {
773 tag "update-alternatives-remove-called-in-postrm", "";
776 for my $rule (@depends_needed) {
777 my ($package, $regex) = @$rule;
778 if ($pkg ne $package and /$regex/ and ! $warned{$package}) {
779 if (m,-x\s+\S*$regex, or m,which\s+$regex, or m,command\s+.*?$regex,) {
780 $warned{$package} = 1;
782 my $needed = Dep::parse($package);
783 unless (Dep::implies($deps{depends}, $needed) || Dep::implies($deps{'pre-depends'}, $needed)) {
784 my $shortpackage = $package;
785 $shortpackage =~ s/[ \(].*//;
786 tag "maintainer-script-needs-depends-on-$shortpackage", "$file";
787 $warned{$package} = 1;
793 if (m,\bgconftool(-2)?(\s|\Z),) {
794 tag "gconftool-used-in-maintainer-script", "$file:$.";
796 if (m,\binstall-sgmlcatalog\b, && !(m,--remove, && ($file eq 'prerm' || $file eq 'postinst'))) {
797 tag "install-sgmlcatalog-deprecated", "$file:$.";
799 if (m,/var/lib/dpkg/status\b, && $pkg ne 'base-files' && $pkg ne 'dpkg') {
800 tag "maintainer-script-uses-dpkg-status-directly", "$file";
804 if ($saw_init && ! $saw_invoke) {
805 tag "maintainer-script-calls-init-script-directly", "$file:$saw_init";
808 tag "maintainer-script-empty", $file;
818 # -----------------------------------
820 # Returns non-zero if the given file is not actually a shell script,
821 # just looks like one.
822 sub script_is_evil_and_wrong {
825 open (IN, '<', $filename) or fail("cannot open $filename: $!");
828 my $backgrounded = 0;
836 # the exec should either be "eval"ed or a new statement
837 (^\s*|\beval\s*[\'\"]|(;|&&)\s*)
839 # eat anything between the exec and $0
842 # optionally quoted executable name (via $0)
845 # optional "end of options" indicator
848 # Match expressions of the form '${1+$@}', '${1:+"$@"',
849 # '"${1+$@', "$@", etc where the quotes (before the dollar
850 # sign(s)) are optional and the second (or only if the $1
851 # clause is omitted) parameter may be $@ or $*.
853 # Finally the whole subexpression may be omitted for scripts
854 # which do not pass on their parameters (i.e. after re-execing
855 # they take their parameters (and potentially data) from stdin
856 .?(\${1:?\+.?)?(\$(\@|\*))?~x) {
859 } elsif (/^\s*(\w+)=\$0;/) {
862 # Match scripts which use "foo $0 $@ &\nexec true\n"
869 .?(\${1:?\+.?)?(\$(\@|\*))?.?\s*\&~x) {
872 } elsif ($backgrounded and m~
873 # the exec should either be "eval"ed or a new statement
874 (^\s*|\beval\s*[\'\"]|(;|&&)\s*)
875 exec\s+true(\s|\Z)~x) {
885 # Given an interpretor and a file, run the interpretor on that file with the
886 # -n option to check syntax, discarding output and returning the exit status.
887 sub check_script_syntax {
888 my ($interpreter, $script) = @_;
891 fail("cannot fork: $!");
892 } elsif ($pid == 0) {
893 open STDOUT, '>/dev/null' or fail("cannot reopen stdout: $!");
894 open STDERR, '>&STDOUT' or fail("cannot reopen stderr: $!");
895 exec $interpreter, '-n', $script
896 or fail("cannot exec $interpreter: $!");
906 # indent-tabs-mode: t
907 # cperl-indent-level: 4
909 # vim: syntax=perl ts=8 sw=4