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 Maemian::scripts;
28 use lib "$ENV{'MAEMIAN_ROOT'}/checks/";
33 use Maemian::Relation;
35 # This is a map of all known interpreters. The key is the interpreter name
36 # (the binary invoked on the #! line). The value is an anonymous array of one
37 # or two elements. The first, mandatory argument is the path on a Debian
38 # system where that interpreter would be installed. The second, optional
39 # argument is the dependency that provides that interpreter. If the second
40 # argument isn't given, the package name is assumed to be the same as the
41 # interpreter name. (Saves some typing.)
43 # Some interpreters list empty dependencies (as opposed to undefined ones).
44 # Those interpreters should not have any dependency for one reason or another
45 # (usually because they're essential packages or aren't used in a normal way).
47 # Do not list versioned patterns here (such as pythonX.Y, rubyX.Y, etc.). For
48 # those, see %versioned_interpreters below.
51 awk => [ '/usr/bin', '' ],
52 bash => [ '/bin', '' ],
53 bltwish => [ '/usr/bin', 'blt' ],
54 clisp => [ '/usr/bin' ],
55 csh => [ '/bin', 'tcsh | csh | c-shell' ],
57 expect => [ '/usr/bin' ],
58 expectk => [ '/usr/bin' ],
59 fish => [ '/usr/bin' ],
60 gawk => [ '/usr/bin' ],
61 gbr2 => [ '/usr/bin', 'gambas2-runtime' ],
62 gbx => [ '/usr/bin', 'gambas-runtime' ],
63 gbx2 => [ '/usr/bin', 'gambas2-runtime' ],
64 gforth => [ '/usr/bin' ],
65 gnuplot => [ '/usr/bin' ],
66 gosh => [ '/usr/bin', 'gauche' ],
67 icmake => [ '/usr/bin', 'icmake' ],
68 'install-menu' => [ '/usr/bin', '' ],
69 jed => [ '/usr/bin' ],
70 'jed-script' => [ '/usr/bin', 'jed | xjed' ],
71 kaptain => [ '/usr/bin' ],
72 ksh => [ '/bin', 'ksh | mksh | pdksh | zsh' ],
73 lefty => [ '/usr/bin', 'graphviz' ],
74 magicfilter => [ '/usr/sbin' ],
75 make => [ '/usr/bin', 'make | build-essential | dpkg-dev' ],
76 mawk => [ '/usr/bin' ],
78 nickle => [ '/usr/bin' ],
79 ocamlrun => [ '/usr/bin',
80 'ocaml-base-nox | ocaml-base | ocaml-nox | ocaml' ],
81 pagsh => [ '/usr/bin', 'openafs-client | heimdal-clients' ],
82 parrot => [ '/usr/bin' ],
83 perl => [ '/usr/bin', '' ],
84 procmail => [ '/usr/bin' ],
85 python => [ '/usr/bin', 'python | python-minimal' ],
86 pforth => [ '/usr/bin' ],
88 regina => [ '/usr/bin', 'regina-rexx' ],
89 rexx => [ '/usr/bin', 'regina-rexx' ],
90 rrdcgi => [ '/usr/bin', 'rrdtool' ],
91 ruby => [ '/usr/bin' ],
92 runhugs => [ '/usr/bin', 'hugs | hugs98' ],
93 sed => [ '/bin', '' ],
95 slsh => [ '/usr/bin' ],
96 speedy => [ '/usr/bin', 'speedy-cgi-perl' ],
97 tcsh => [ '/usr/bin' ],
98 tixwish => [ '/usr/bin', 'tix' ],
99 trs => [ '/usr/bin', 'konwert' ],
100 xjed => [ '/usr/bin', 'xjed' ],
101 yforth => [ '/usr/bin', 'yforth' ],
102 yorick => [ '/usr/bin' ],
103 zsh => [ '/bin', 'zsh | zsh-beta' ],
106 # The more complex case of interpreters that may have a version number.
108 # This is a hash from the base interpreter name to a list. The base
109 # interpreter name may appear by itself or followed by some combination of
110 # dashes, digits, and periods. The values are the directory in which the
111 # interpreter is found, the dependency to add for a version-less interpreter,
112 # a regular expression to match versioned interpreters and extract the version
113 # number, the package dependency for a versioned interpreter, and the list of
116 # An interpreter with a version must have a dependency on the specific package
117 # formed by taking the fourth element of the list and replacing $1 with the
118 # version number. An interpreter without a version is rejected if the second
119 # element is undef; otherwise, the package must satisfy a dependency on the
120 # disjunction of the second argument (if non-empty) and all the packages
121 # formed by taking the list of known versions (the fifth element and on) and
122 # replacing $1 in the fourth argument with them.
126 # lua => [ '/usr/bin', 'lua', qr/^lua([\d.]+)$/, 'lua$1', qw(40 50 5.1) ]
128 # says that any lua interpreter must be in /usr/bin, a package using
129 # /usr/bin/lua50 must depend on lua50, and a package using just /usr/bin/lua
130 # must satisfy lua | lua40 | lusa50 | lua5.1.
132 # The list of known versions is the largest maintenance headache here, but
133 # it's only used for the unversioned dependency handling, and then only when
134 # someone uses the unversioned script but depends on a specific version for
135 # some reason. So it's not a huge problem if it's a little out of date.
136 our %versioned_interpreters =
137 (guile => [ '/usr/bin', 'guile',
138 qr/^guile-([\d.]+)$/, 'guile-$1', qw(1.6 1.8)
140 jruby => [ '/usr/bin', 'jruby',
141 qr/^jruby([\d.]+)$/, 'jruby$1', qw(1.0 1.1 1.2)
143 lua => [ '/usr/bin', 'lua',
144 qr/^lua([\d.]+)$/, 'lua$1', qw(40 50 5.1)
146 octave => [ '/usr/bin', 'octave',
147 qr/^octave([\d.]+)$/, 'octave$1', qw(2.1 3.0 3.1)
149 php => [ '/usr/bin', '',
150 qr/^php(\d+)$/, 'php$1-cli', qw(5)
152 pike => [ '/usr/bin', '',
153 qr/^pike([\d.]+)$/, 'pike$1 | pike$1-core', qw(7.6)
155 python => [ '/usr/bin', undef,
156 qr/^python([\d.]+)$/, 'python$1 | python$1-minimal',
159 ruby => [ '/usr/bin', undef,
160 qr/^ruby([\d.]+)$/, 'ruby$1', qw(1.8 1.9)
162 scsh => [ '/usr/bin', 'scsh',
163 qr/^scsh-([\d.]+)$/, 'scsh-$1', qw(0.6)
165 tclsh => [ '/usr/bin', 'tclsh | tcl',
166 qr/^tclsh([\d.]+)$/, 'tcl$1', qw(8.3 8.4 8.5 8.6)
168 wish => [ '/usr/bin', 'wish | tk',
169 qr/^wish([\d.]+)$/, 'tk$1', qw(8.3 8.4 8.5 8.6)
173 # Any of the following packages can satisfy an update-inetd dependency.
175 = join (' | ', qw(update-inetd inet-superserver openbsd-inetd
176 inetutils-inetd rlinetd xinetd));
178 # Appearance of one of these regexes in a maintainer script means that there
179 # must be a dependency (or pre-dependency) on the given package. The tag
180 # reported is maintainer-script-needs-depends-on-%s, so be sure to update
181 # scripts.desc when adding a new rule.
182 our @depends_needed = (
183 [ adduser => '\badduser\s' ],
184 [ gconf2 => '\bgconf-schemas\s' ],
185 [ $update_inetd => '\bupdate-inetd\s' ],
186 [ ucf => '\bucf\s' ],
187 [ 'xml-core' => '\bupdate-xmlcatalog\s' ],
190 # When detecting commands inside shell scripts, use this regex to match the
191 # beginning of the command rather than checking whether the command is at the
192 # beginning of a line.
193 our $LEADIN = qr'(?:(?:^|[`&;(|{])\s*|(?:if|then|do|while)\s+)';
195 our @bashism_single_quote_regexs = (
196 $LEADIN . qr'echo\s+(?:-[^e\s]+\s+)?\'[^\']*(\\[\\abcEfnrtv0])+.*?[\']',
197 # unsafe echo with backslashes
198 $LEADIN . qr'source\s+[\"\']?(?:\.\/|\/|\$|[\w.-])[^\s]+',
199 # should be '.', not 'source'
201 our @bashism_string_regexs = (
202 qr'\$\[\w+\]', # arith not allowed
203 qr'\$\{\w+\:\d+(?::\d+)?\}', # ${foo:3[:1]}
204 qr'\$\{\w+(/.+?){1,2}\}', # ${parm/?/pat[/str]}
205 qr'\$\{\#?\w+\[[0-9\*\@]+\]\}',# bash arrays, ${name[0|*|@]}
206 qr'\$\{!\w+[\@*]\}', # ${!prefix[*|@]}
207 qr'\$\{!\w+\}', # ${!name}
208 qr'(\$\(|\`)\s*\<\s*\S+\s*(\)|\`)', # $(\< foo) should be $(cat foo)
209 qr'\$\{?RANDOM\}?\b', # $RANDOM
210 qr'\$\{?(OS|MACH)TYPE\}?\b', # $(OS|MACH)TYPE
211 qr'\$\{?HOST(TYPE|NAME)\}?\b', # $HOST(TYPE|NAME)
212 qr'\$\{?DIRSTACK\}?\b', # $DIRSTACK
213 qr'\$\{?EUID\}?\b', # $EUID should be "id -u"
214 qr'\$\{?UID\}?\b', # $UID should be "id -ru"
215 qr'\$\{?SECONDS\}?\b', # $SECONDS
216 qr'\$\{?BASH_[A-Z]+\}?\b', # $BASH_SOMETHING
217 qr'\$\{?SHELLOPTS\}?\b', # $SHELLOPTS
218 qr'\$\{?PIPESTATUS\}?\b', # $PIPESTATUS
219 qr'\$\{?SHLVL\}?\b', # $SHLVL
220 qr'<<<', # <<< here string
221 $LEADIN . qr'echo\s+(?:-[^e\s]+\s+)?\"[^\"]*(\\[\\abcEfnrtv0])+.*?[\"]',
222 # unsafe echo with backslashes
224 our @bashism_regexs = (
225 qr'(?:^|\s+)function \w+(\s|\(|\Z)', # function is useless
226 qr'(test|-o|-a)\s*[^\s]+\s+==\s', # should be 'b = a'
227 qr'\[\s+[^\]]+\s+==\s', # should be 'b = a'
228 qr'\s(\|\&)', # pipelining is not POSIX
229 qr'[^\\\$]\{(?:[^\s\\\}]*?,)+[^\\\}\s]*\}', # brace expansion
230 qr'(?:^|\s+)\w+\[\d+\]=', # bash arrays, H[0]
231 $LEADIN . qr'read\s+(?:-[a-qs-zA-Z\d-]+)',
232 # read with option other than -r
233 $LEADIN . qr'read\s*(?:-\w+\s*)*(?:\".*?\"|[\'].*?[\'])?\s*(?:;|$)',
234 # read without variable
235 $LEADIN . qr'kill\s+-[^sl]\w*',# kill -[0-9] or -[A-Z]
236 $LEADIN . qr'trap\s+["\']?.*["\']?\s+.*[1-9]', # trap with signal numbers
238 qr'(<\&|>\&)\s*((-|\d+)[^\s;|)`&\\\\]|[^-\d\s]+)', # should be >word 2>&1
239 qr'\[\[(?!:)', # alternative test command
240 $LEADIN . qr'select\s+\w+', # 'select' is not POSIX
241 $LEADIN . qr'echo\s+(-n\s+)?-n?en?', # echo -e
242 $LEADIN . qr'exec\s+-[acl]', # exec -c/-l/-a name
243 qr'(?:^|\s+)let\s', # let ...
244 qr'(?<![\$\(])\(\(.*\)\)', # '((' should be '$(('
245 qr'\$\[[^][]+\]', # '$[' should be '$(('
246 qr'(\[|test)\s+-a', # test with unary -a (should be -e)
247 qr'/dev/(tcp|udp)', # /dev/(tcp|udp)
248 $LEADIN . qr'\w+\+=', # should be "VAR="${VAR}foo"
249 $LEADIN . qr'suspend\s',
250 $LEADIN . qr'caller\s',
251 $LEADIN . qr'complete\s',
252 $LEADIN . qr'compgen\s',
253 $LEADIN . qr'declare\s',
254 $LEADIN . qr'typeset\s',
255 $LEADIN . qr'disown\s',
256 $LEADIN . qr'builtin\s',
257 $LEADIN . qr'set\s+-[BHT]+', # set -[BHT]
258 $LEADIN . qr'alias\s+-p', # alias -p
259 $LEADIN . qr'unalias\s+-a', # unalias -a
260 $LEADIN . qr'local\s+-[a-zA-Z]+', # local -opt
261 qr'(?:^|\s+)\s*\(?\w*[^\(\w\s]+\S*?\s*\(\)\s*([\{|\(]|\Z)',
262 # function names should only contain [a-z0-9_]
263 $LEADIN . qr'(push|pop)d(\s|\Z)', # (push|pod)d
264 $LEADIN . qr'export\s+-[^p]', # export only takes -p as an option
265 $LEADIN . qr'ulimit(\s|\Z)',
266 $LEADIN . qr'shopt(\s|\Z)',
267 $LEADIN . qr'type\s',
268 $LEADIN . qr'time\s',
269 $LEADIN . qr'dirs(\s|\Z)',
270 qr'(?:^|\s+)[<>]\(.*?\)', # <() process substituion
271 qr'(?:^|\s+)readonly\s+-[af]', # readonly -[af]
272 $LEADIN . qr'(sh|\$\{?SHELL\}?) -[rD]', # sh -[rD]
273 $LEADIN . qr'(sh|\$\{?SHELL\}?) --\w+', # sh --long-option
274 $LEADIN . qr'(sh|\$\{?SHELL\}?) [-+]O', # sh [-+]O
285 # no dependency for install-menu, because the menu package specifically
286 # says not to depend on it.
292 foreach (sort keys %{$info->index}) {
294 my $index_info = $info->index->{$_};
295 my $operm = $index_info->{operm};
296 next unless ($index_info->{type} =~ m,^[-h], and ($operm & 01 or
297 $operm & 010 or $operm & 0100));
298 my $is_suid = $operm & 04000;
299 $executable{'./' . $_} = 1;
300 $suid{'./' . $_} = $is_suid;
303 for my $file (sort keys %{$info->file_info}) {
304 $ELF{'./' . $file} = 1 if $info->file_info->{$file} =~ /^[^,]*\bELF\b/o;
308 for my $field (qw/suggests recommends depends pre-depends provides/) {
309 if (defined $info->field($field)) {
310 $all_deps .= ', ' if $all_deps;
311 $all_deps .= $info->field($field);
314 $all_deps .= ', ' if $all_deps;
316 my $all_parsed = Maemian::Relation->new($all_deps);
318 for my $filename (sort keys %{$info->scripts}) {
319 my $interpreter = $info->scripts->{$filename}->{interpreter};
320 my $calls_env = $info->scripts->{$filename}->{calls_env};
321 $filename = './' . $filename;
322 $scripts{$filename} = 1;
324 # no checks necessary at all for scripts in /usr/share/doc/
325 next if $filename =~ m,usr/share/doc/,;
327 my ($base) = $interpreter =~ m,([^/]*)$,;
329 # allow exception for .in files that have stuff like #!@PERL@
330 next if ($filename =~ m,\.in$, and $interpreter =~ m,^(\@|<\<)[A-Z_]+(\@|>\>)$,);
332 my $is_absolute = ($interpreter =~ m,^/, or defined $calls_env);
334 # Skip files that have the #! line, but are not executable and do not have
335 # an absolute path and are not in a bin/ directory (/usr/bin, /bin etc)
336 # They are probably not scripts after all.
337 next if ($filename !~ m,(bin/|etc/init\.d/), and !$executable{$filename}
340 if ($interpreter eq "") {
341 tag("script-without-interpreter", $filename);
345 # Either they use an absolute path or they use '/usr/bin/env interp'.
346 tag("interpreter-not-absolute", $filename, "#!$interpreter")
348 tag("script-not-executable", $filename)
349 unless ($executable{$filename}
350 or $filename =~ m,^\./usr/(lib|share)/.*\.pm,
351 or $filename =~ m,^\./usr/(lib|share)/.*\.py,
352 or $filename =~ m,^\./usr/(lib|share)/ruby/.*\.rb,
353 or $filename =~ m,\.in$,
354 or $filename =~ m,\.ex$,
355 or $filename eq './etc/init.d/skeleton'
356 or $filename =~ m,^\./etc/menu-methods,
357 or $filename =~ m,^\./etc/X11/Xsession\.d,);
359 # Warn about csh scripts.
360 tag("csh-considered-harmful", $filename)
361 if (($base eq 'csh' or $base eq 'tcsh')
362 and $executable{$filename}
363 and $filename !~ m,^\./etc/csh/login\.d/,);
365 # Syntax-check most shell scripts, but don't syntax-check scripts that end
366 # in .dpatch. bash -n doesn't stop checking at exit 0 and goes on to blow
367 # up on the patch itself.
368 if ($base =~ /^$known_shells_regex$/) {
370 and ! script_is_evil_and_wrong("unpacked/$filename")
371 and $filename !~ m,\.dpatch$,
372 # exclude some shells. zsh -n is broken, see #485885
373 and $base !~ m/^(z|t?c)sh$/) {
375 if (check_script_syntax($interpreter, "unpacked/$filename")) {
376 tag("shell-script-fails-syntax-check", $filename);
381 # Try to find the expected path of the script to check. First check
382 # %interpreters and %versioned_interpreters. If not found there, see if
383 # it ends in a version number and the base is found in
384 # %versioned_interpreters.
385 my $data = $interpreters{$base};
387 if (not defined $data) {
388 $data = $versioned_interpreters{$base};
389 undef $data if ($data and not defined ($data->[1]));
390 if (not defined ($data) and $base =~ /^(.*[^\d.-])-?[\d.]+$/) {
391 $data = $versioned_interpreters{$1};
392 undef $data unless ($data and $base =~ /$data->[2]/);
394 $versioned = 1 if $data;
397 my $expected = $data->[0] . '/' . $base;
398 unless ($interpreter eq $expected or defined $calls_env) {
399 tag("wrong-path-for-interpreter",
400 "#!$interpreter != $expected", "($filename)");
402 } elsif ($interpreter =~ m,/usr/local/,) {
403 tag("interpreter-in-usr-local", $filename, "#!$interpreter");
404 } elsif ($executable{'.' . $interpreter}) {
405 # Package installs the interpreter itself, so it's probably ok. Don't
406 # emit any tag for this.
407 } elsif ($base eq 'suidperl') {
408 tag("calls-suidperl-directly", $filename);
409 } elsif ($interpreter eq '/bin/env') {
410 tag("script-uses-bin-env", $filename);
412 tag("unusual-interpreter", $filename, "#!$interpreter");
415 # Do some additional checks on shell scripts in /etc. This should
416 # probably be extended eventually to any script in a public directory.
417 # This also needs smarter processing of multiline quoted strings,
418 # heredocs, and so forth. Hopefully it will do for right now.
419 if ($filename =~ m,^./etc/, and $base =~ /^$known_shells_regex$/) {
420 my ($saw_init, $saw_invoke);
422 open(FH, '<', 'unpacked/' . $filename);
424 next if m,^\s*$,; # skip empty lines
425 next if m,^\s*\#,; # skip comment lines
426 $_ = remove_comments($_);
429 # Check for running init scripts directly instead of via
430 # invoke-rc.d. Scripts are allowed to reinvoke themselves with a
431 # different argument; some init scripts implement actions that
432 # way. Scripts are also allowed to do this for actions other than
433 # those defined for invoke-rc.d.
434 if (m,$LEADIN/etc/init.d/(\S+)\s+[\"\']?(\S+)[\"\']?,) {
435 my ($script, $action) = ($1, $2);
436 next if "./etc/init.d/$script" eq $filename;
437 next unless $action =~ /^(force-)?(start|stop|restart|reload|status)$/;
440 if (m%^\s*invoke-rc\.d\s+%) {
445 if ($saw_init and not $saw_invoke) {
446 tag 'script-calls-init-script-directly', "$filename:$saw_init";
450 # If we found the interpreter and the script is executable, check
451 # dependencies. This should be the last thing we do in the loop so that
452 # we can use next for an early exit and reduce the nesting.
453 next unless ($data && $executable{$filename});
455 my $depends = $data->[1];
456 if (not defined $depends) {
459 if ($depends && !$all_parsed->implies($depends)) {
460 if ($base =~ /^(python|ruby|(m|g)awk)$/) {
461 tag("$base-script-but-no-$base-dep", $filename);
462 } elsif ($base eq 'csh' && $filename =~ m,^\./etc/csh/login\.d/,) {
463 # Initialization files for csh.
464 } elsif ($base eq 'fish' && $filename =~ m,^\./etc/fish\.d/,) {
465 # Initialization files for fish.
466 } elsif ($base eq 'ocamlrun' && $all_deps =~ /\bocaml(-base)?(-nox)?-\d\.[\d.]+/) {
467 # ABI-versioned virtual packages for ocaml
469 tag('missing-dep-for-interpreter', "$base => $depends",
473 if ($base eq 'perl' && $suid{$filename}) {
474 tag("suid-perl-script-but-no-perl-suid-dep", $filename)
475 unless $all_parsed->implies('perl-suid');
477 } elsif ($versioned_interpreters{$base}) {
478 my @versions = @$data[4 .. @$data - 1];
484 unshift (@depends, $data->[1]) if length $data->[1];
485 my $depends = join (' | ', @depends);
486 unless ($all_parsed->implies($depends)) {
487 if ($base eq 'php') {
488 tag('php-script-but-no-phpX-cli-dep', $filename);
489 } elsif ($base =~ /^(wish|tclsh)/) {
490 tag("$1-script-but-no-$1-dep", $filename);
492 tag("missing-dep-for-interpreter", "$base => $depends",
497 my ($version) = ($base =~ /$data->[2]/);
498 my $depends = $data->[3];
499 $depends =~ s/\$1/$version/g;
500 unless ($all_parsed->implies($depends)) {
501 if ($base =~ /^php/) {
502 tag('php-script-but-no-phpX-cli-dep', $filename);
503 } elsif ($base =~ /^(python|ruby)/) {
504 tag("$1-script-but-no-$1-dep", $filename);
506 tag("missing-dep-for-interpreter", "$base => $depends",
513 foreach (keys %executable) {
514 tag("executable-not-elf-or-script", $_)
517 or $_ =~ m,^usr(/X11R6)?/man/,
518 or $_ =~ m/\.exe$/ # mono convention
522 open(SCRIPTS, '<', "control-scripts")
523 or fail("cannot open lintian control-scripts file: $!");
525 # Handle control scripts. This is an edited version of the code for
526 # normal scripts above, because there were just enough differences to
527 # make a shared function awkward.
529 my %added_diversions;
530 my %removed_diversions;
531 my $expand_diversions = 0;
535 m/^(\S*) (.*)$/ or fail("bad line in control-scripts file: $_");
536 my $interpreter = $1;
538 my $filename = "control/$file";
540 $interpreter =~ m|([^/]*)$|;
543 if ($interpreter eq "") {
544 tag("script-without-interpreter", $filename);
548 tag("interpreter-not-absolute", $filename, "#!$interpreter")
549 unless ($interpreter =~ m|^/|);
551 if ($interpreter =~ m|/usr/local/|) {
552 tag("control-interpreter-in-usr-local", $filename, "#!$interpreter");
553 } elsif ($base eq 'sh' or $base eq 'bash' or $base eq 'perl') {
554 my $expected = $interpreters{$base}->[0] . '/' . $base;
555 tag("wrong-path-for-interpreter", "#!$interpreter != $expected",
557 unless ($interpreter eq $expected);
558 } elsif ($file eq 'config') {
559 tag('forbidden-config-interpreter', "#!$interpreter");
560 } elsif ($file eq 'postrm') {
561 tag('forbidden-postrm-interpreter', "#!$interpreter");
562 } elsif (exists $interpreters{$base}) {
563 my $data = $interpreters{$base};
564 my $expected = $data->[0] . '/' . $base;
565 unless ($interpreter eq $expected) {
566 tag("wrong-path-for-interpreter", "#!$interpreter != $expected",
569 tag('unusual-control-interpreter', $filename, "#!$interpreter");
571 # Interpreters used by preinst scripts must be in Pre-Depends.
572 # Interpreters used by postinst or prerm scripts must be in Depends.
573 unless (defined ($data->[1]) and not $data->[1]) {
574 my $depends = Maemian::Relation->new($data->[1] || $base);
575 if ($file eq 'preinst') {
576 unless ($info->relation('pre-depends')->implies($depends)) {
577 tag('preinst-interpreter-without-predepends',
581 unless ($info->relation('strong')->implies($depends)) {
582 tag('control-interpreter-without-depends', $filename,
588 tag("unknown-control-interpreter", $filename, "#!$interpreter");
589 next; # no use doing further checks if it's not a known interpreter
592 # perhaps we should warn about *csh even if they're somehow screwed,
593 # but that's not really important...
594 tag("csh-considered-harmful", $filename)
595 if ($base eq 'csh' or $base eq 'tcsh');
597 my $shellscript = $base =~ /^$known_shells_regex$/ ? 1 : 0;
599 # Only syntax-check scripts we can check with bash.
602 $checkbashisms = $base eq "sh" ? 1 : 0;
603 if ($base eq 'sh' or $base eq 'bash') {
604 if (check_script_syntax("/bin/bash", $filename)) {
605 tag("maintainer-shell-script-fails-syntax-check", $file);
610 # now scan the file contents themselves
611 open (C, '<', "$filename")
612 or fail("cannot open maintainer script $filename for reading: $!");
615 my ($saw_init, $saw_invoke, $saw_debconf, $saw_bange, $saw_sete, $has_code);
618 my $previous_line = "";
620 if ($. == 1 && $shellscript && m,/$base\s*.*\s-\w*e\w*\b,) {
624 next if m,^\s*$,; # skip empty lines
625 next if m,^\s*\#,; # skip comment lines
626 $_ = remove_comments($_);
628 # Concatenate lines containing continuation character (\) at the end
629 if ($shellscript && /\\$/) {
632 $previous_line .= $_;
637 $_ = $previous_line . $_;
640 # Don't consider the standard dh-make boilerplate to be code. This
641 # means ignoring the framework of a case statement, the labels, the
642 # echo complaining about unknown arguments, and an exit.
644 || m/^\s*set\s+-\w+\s*$/
645 || m/^\s*case\s+\"?\$1\"?\s+in\s*$/
646 || m/^\s*(?:[a-z|-]+|\*)\)\s*$/
648 || m/^\s*echo\s+\"[^\"]+\"(?:\s*>&2)?\s*$/
650 || m/^\s*exit\s+\d+\s*$/) {
654 if ($shellscript && m,${LEADIN}set\s*(\s+-(-.*|[^e]+))*\s-\w*e,) {
658 if (m,[^\w]((/var)?/tmp|\$TMPDIR)/[^)\]}\s], and not m/\bmks?temp\b/ and not m/\btempfile\b/ and not m/\bmkdir\b/ and not m/\$RANDOM/) {
659 tag "possibly-insecure-handling-of-tmp-files-in-maintainer-script", "$file:$."
663 if (m/^\s*killall(?:\s|\z)/) {
664 tag "killall-is-dangerous", "$file:$." unless $warned{killall};
665 $warned{killall} = 1;
667 if (m/^\s*mknod(?:\s|\z)/ and not m/\sp\s/) {
668 tag "mknod-in-maintainer-script", "$file:$.";
671 # Collect information about init script invocations to catch running
672 # init scripts directly rather than through invoke-rc.d. Since the
673 # script is allowed to run the init script directly if invoke-rc.d
674 # doesn't exist, only tag direct invocations where invoke-rc.d is
675 # never used in the same script. Lots of false negatives, but
676 # hopefully not many false positives.
677 if (m%^\s*/etc/init\.d/(\S+)\s+[\"\']?(\S+)[\"\']?%) {
680 if (m%^\s*invoke-rc\.d\s+%) {
685 if ($cat_string ne "" and m/^\Q$cat_string\E$/) {
688 my $within_another_shell = 0;
689 if (m,(?:^|\s+)(?:(?:/usr)?/bin/)?($known_shells_regex)\s+-c\s*.+,
691 $within_another_shell = 1;
693 # if cat_string is set, we are in a HERE document and need not
695 if ($cat_string eq "" and $checkbashisms and !$within_another_shell) {
699 # since this test is ugly, I have to do it by itself
700 # detect source (.) trying to pass args to the command it runs
701 # The first expression weeds out '. "foo bar"'
703 not m/^\s*\.\s+(\"[^\"]+\"|\'[^\']+\')\s*(\&|\||\d?>|<|;|\Z)/
704 and m/^\s*(\.\s+[^\s;\`:]+\s+([^\s;]+))/) {
707 ($match, $extra) = ($1, $2);
708 if ($extra =~ /^(\&|\||\d?>|<)/) {
719 for my $re (@bashism_single_quote_regexs) {
720 if ($line =~ m/($re)/) {
728 # Ignore anything inside single quotes; it could be an
729 # argument to grep or the like.
731 # $cat_line contains the version of the line we'll check
732 # for heredoc delimiters later. Initially, remove any
733 # spaces between << and the delimiter to make the following
734 # updates to $cat_line easier.
735 my $cat_line = $line;
736 $cat_line =~ s/(<\<-?)\s+/$1/g;
738 # Remove single quoted strings, with the exception that we
739 # don't remove the string
740 # if the quote is immediately preceeded by a < or a -, so we
741 # can match "foo <<-?'xyz'" as a heredoc later
742 # The check is a little more greedy than we'd like, but the
743 # heredoc test itself will weed out any false positives
744 $cat_line =~ s/(^|[^<\\\"-](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g;
747 # Remove "quoted quotes". They're likely to be inside
748 # another pair of quotes; we're not interested in
749 # them for their own sake and removing them makes finding
750 # the limits of the outer pair far easier.
751 $line =~ s/(^|[^\\\'\"])\"\'\"/$1/g;
752 $line =~ s/(^|[^\\\'\"])\'\"\'/$1/g;
754 $line =~ s/(^|[^\\\"](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g;
755 for my $re (@bashism_string_regexs) {
756 if ($line =~ m/($re)/) {
764 # We've checked for all the things we still want to notice in
765 # double-quoted strings, so now remove those strings as well.
766 $cat_line =~ s/(^|[^<\\\'-](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g;
768 $line =~ s/(^|[^\\\'](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g;
769 for my $re (@bashism_regexs) {
770 if ($line =~ m/($re)/) {
779 tag "possible-bashism-in-maintainer-script", "$file:$. \'$match\'";
782 # Only look for the beginning of a heredoc here, after we've
783 # stripped out quoted material, to avoid false positives.
784 if ($cat_line =~ m/(?:^|[^<])\<\<\-?\s*(?:[\\]?(\w+)|[\'\"](.*?)[\'\"])/) {
786 $cat_string = $2 if not defined $cat_string;
790 if (/^\s*start-stop-daemon\s+/ && !/\s--stop\b/) {
791 tag 'start-stop-daemon-in-maintainer-script', "$file:$.";
793 # Don't use chown foo.bar
794 if (/(chown(\s+--?[A-Za-z-]+)*\s+[-_A-Za-z0-9]+\.[-_A-Za-z0-9]+)\s+/) {
795 tag "deprecated-chown-usage", "$file:$. \'$1\'";
797 if (/invoke-rc.d.*\|\| exit 0/) {
798 tag "maintainer-script-hides-init-failure", "$file:$.";
800 if (m,/usr/share/debconf/confmodule,) {
803 if (m/^\s*read(?:\s|\z)/ && !$saw_debconf) {
804 tag "read-in-maintainer-script", "$file:$.";
806 if (m,^\s*rm\s+([^>]*\s)?/dev/,) {
807 tag "maintainer-script-removes-device-files", "$file:$.";
809 if (m,>\s*(/etc/(?:services|protocols|rpc))(\s|\Z),) {
810 tag "maintainer-script-modifies-netbase-managed-file", "$file:$. $1";
812 if (m,^\s*(?:cp|mv)\s.*(/etc/(?:services|protocols|rpc))\s*$,) {
813 tag "maintainer-script-modifies-netbase-managed-file", "$file:$. $1";
815 if (m,>\s*/etc/inetd\.conf(\s|\Z),) {
816 tag "maintainer-script-modifies-inetd-conf", "$file:$."
817 unless $info->relation('provides')->implies('inet-superserver');
819 if (m,^\s*(?:cp|mv)\s+(?:.*\s)?/etc/inetd\.conf\s*$,) {
820 tag "maintainer-script-modifies-inetd-conf", "$file:$."
821 unless $info->relation('provides')->implies('inet-superserver');
823 if (m,^$LEADIN(/(usr/)?s?bin/[\w.+-]+)(\s|;|$),) {
824 tag "command-with-path-in-maintainer-script", "$file:$. $1";
827 # Ancient dpkg feature tests.
828 if (m/^\s*dpkg\s+--assert-support-predepends\b/) {
829 tag "ancient-dpkg-predepends-check", "$file:$.";
831 if (m/^\s*dpkg\s+--assert-working-epoch\b/) {
832 tag "ancient-dpkg-epoch-check", "$file:$.";
834 if (m/^dpkg\s+--assert-long-filenames\b/) {
835 tag "ancient-dpkg-long-filenames-check", "$file:$.";
837 if (m/^dpkg\s+--assert-multi-conrep\b/) {
838 tag "ancient-dpkg-multi-conrep-check", "$file:$.";
842 if (m,\bsuidregister\b,) {
843 tag "suidregister-used-in-maintainer-script", "$file";
845 if ($file eq 'postrm') {
846 if (m,update\-alternatives \-\-remove,) {
847 tag "update-alternatives-remove-called-in-postrm", "";
850 for my $rule (@depends_needed) {
851 my ($package, $regex) = @$rule;
852 if ($pkg ne $package and /$regex/ and ! $warned{$package}) {
853 if (m,-x\s+\S*$regex, or m,(which|type)\s+$regex, or m,command\s+.*?$regex,) {
854 $warned{$package} = 1;
856 unless ($info->relation('strong')->implies($package)) {
857 my $shortpackage = $package;
858 $shortpackage =~ s/[ \(].*//;
859 tag "maintainer-script-needs-depends-on-$shortpackage", "$file";
860 $warned{$package} = 1;
866 if (m,\bgconftool(-2)?(\s|\Z),) {
867 tag "gconftool-used-in-maintainer-script", "$file:$.";
869 if (m,\binstall-sgmlcatalog\b, && !(m,--remove, && ($file eq 'prerm' || $file eq 'postinst'))) {
870 tag "install-sgmlcatalog-deprecated", "$file:$.";
872 if (m,/var/lib/dpkg/status\b, && $pkg ne 'base-files' && $pkg ne 'dpkg') {
873 tag "maintainer-script-uses-dpkg-status-directly", "$file";
875 if (m,$LEADIN(?:/usr/sbin/)?dpkg-divert\s, && ! /--(?:help|list|truename|version)/) {
876 if (/--local/ or !/--package/) {
877 tag 'package-uses-local-diversion', "$file:$.";
879 my $mode = /--remove/ ? 'remove' : 'add';
880 my ($divert) = /dpkg-divert\s*(.*)$/;
881 $divert =~ s/\s*--(?:add|quiet|remove|rename|test|(:?admindir|divert|package)\s+\S+)//g;
883 # Remove unpaired opening or closing parenthesis
884 while($divert =~ m/\G.*?\(.+?\)/gc) {}
885 $divert =~ s/\G(.*?)[()]/$1/;
886 pos($divert) = undef;
887 # Remove unpaired opening or closing braces
888 while($divert =~ m/\G.*?{.+?}/gc) {}
889 $divert =~ s/\G(.*?)[{}]/$1/;
890 pos($divert) = undef;
892 # position after the last pair of quotation marks, if any
893 while($divert =~ m/\G.*?("|').+?\1/gc) {} #"
894 # Strip anything matching and after '&&', '||', or ';'
895 # this is safe only after we are positioned after the last pair
897 $divert =~ s/\G.+?\K(?: && | \|\| | ;).*$//x;
898 pos($divert) = undef;
899 # Remove quotation marks, they affect:
900 # * our var to regex trick
901 # * stripping the initial slash if the path was quoted
902 $divert =~ s/["']//g; #"
903 # remove the leading / because it's not in the index hash
906 $divert = quotemeta($divert);
908 # For now just replace variables, they will later be normalised
909 $expand_diversions = 1 if $divert =~ s/\\\$\w+/.+/g;
910 $expand_diversions = 1 if $divert =~ s/\\\$\\{\w+.*?\\}/.+/g;
911 # handle $() the same way:
912 $expand_diversions = 1 if $divert =~ s/\\\$\\\(.+?\\\)/.+/g;
914 if ($mode eq 'add') {
915 $added_diversions{$divert} = {'script' => $file, 'line' => $.};
916 } elsif ($mode eq 'remove') {
917 push @{$removed_diversions{$divert}}, {'script' => $file, 'line' => $.};
919 fail "Internal error: \$mode has unknown value: ".
926 if ($saw_init && ! $saw_invoke) {
927 tag "maintainer-script-calls-init-script-directly", "$file:$saw_init";
930 tag "maintainer-script-empty", $file;
932 if ($shellscript && !$saw_sete) {
934 tag 'maintainer-script-without-set-e', $file;
936 tag 'maintainer-script-ignores-errors', $file;
945 # If any of the maintainer scripts used a variable in the file or
946 # diversion name normalise them all
947 if ($expand_diversions) {
948 for my $divert (keys %removed_diversions, keys %added_diversions) {
950 # if a wider regex was found, the entries might no longer be there
951 unless (exists($removed_diversions{$divert})
952 or exists($added_diversions{$divert})) {
956 my $widerrx = $divert;
957 my $wider = $widerrx;
960 # find the widest regex:
966 if ($wider =~ m/^$lrx$/) {
970 } elsif ($l =~ m/^$widerrx$/) {
975 } (keys %removed_diversions, keys %added_diversions);
977 # replace all the occurences with the widest regex:
978 for my $k (@matches) {
979 next if ($k eq $widerrx);
981 if (exists($removed_diversions{$k})) {
982 $removed_diversions{$widerrx} = $removed_diversions{$k};
983 delete $removed_diversions{$k};
985 if (exists($added_diversions{$k})) {
986 $added_diversions{$widerrx} = $added_diversions{$k};
987 delete $added_diversions{$k};
993 for my $divert (keys %removed_diversions) {
994 if (exists $added_diversions{$divert}) {
995 # just mark the entry, because a --remove might
996 # happen in two branches in the script, i.e. we
997 # see it twice, which is not a bug
998 $added_diversions{$divert}{'removed'} = 1;
1000 for my $item (@{$removed_diversions{$divert}}) {
1001 my $script = $item->{'script'};
1002 my $line = $item->{'line'};
1004 next unless ($script eq 'postrm');
1006 # Allow preinst and postinst to remove diversions the
1007 # package doesn't add to clean up after previous
1008 # versions of the package.
1010 $divert = unquote($divert, $expand_diversions);
1012 tag 'remove-of-unknown-diversion', $divert, "$script:$line";
1017 for my $divert (keys %added_diversions) {
1018 my $script = $added_diversions{$divert}{'script'};
1019 my $line = $added_diversions{$divert}{'line'};
1021 my $divertrx = $divert;
1022 $divert = unquote($divert, $expand_diversions);
1024 if ($expand_diversions) {
1025 tag 'diversion-for-unknown-file', $divert, "$script:$line"
1026 unless (grep { $_ =~ m/$divertrx/ } keys %{$info->index});
1028 tag 'diversion-for-unknown-file', $divert, "$script:$line"
1029 unless (exists $info->index->{$divert});
1032 if (not exists $added_diversions{$divertrx}{'removed'}) {
1033 tag 'orphaned-diversion', $divert, $script;
1039 # -----------------------------------
1041 # Returns non-zero if the given file is not actually a shell script,
1042 # just looks like one.
1043 sub script_is_evil_and_wrong {
1044 my ($filename) = @_;
1046 open (IN, '<', $filename) or fail("cannot open $filename: $!");
1049 my $backgrounded = 0;
1055 last if (++$i > 55);
1057 # the exec should either be "eval"ed or a new statement
1058 (^\s*|\beval\s*[\'\"]|(;|&&|\b(then|else))\s*)
1060 # eat anything between the exec and $0
1063 # optionally quoted executable name (via $0)
1066 # optional "end of options" indicator
1069 # Match expressions of the form '${1+$@}', '${1:+"$@"',
1070 # '"${1+$@', "$@", etc where the quotes (before the dollar
1071 # sign(s)) are optional and the second (or only if the $1
1072 # clause is omitted) parameter may be $@ or $*.
1074 # Finally the whole subexpression may be omitted for scripts
1075 # which do not pass on their parameters (i.e. after re-execing
1076 # they take their parameters (and potentially data) from stdin
1077 .?(\${1:?\+.?)?(\$(\@|\*))?~x) {
1080 } elsif (/^\s*(\w+)=\$0;/) {
1083 # Match scripts which use "foo $0 $@ &\nexec true\n"
1090 .?(\${1:?\+.?)?(\$(\@|\*))?.?\s*\&~x) {
1093 } elsif ($backgrounded and m~
1094 # the exec should either be "eval"ed or a new statement
1095 (^\s*|\beval\s*[\'\"]|(;|&&|\b(then|else))\s*)
1096 exec\s+true(\s|\Z)~x) {
1106 # Given an interpretor and a file, run the interpretor on that file with the
1107 # -n option to check syntax, discarding output and returning the exit status.
1108 sub check_script_syntax {
1109 my ($interpreter, $script) = @_;
1111 if (!defined $pid) {
1112 fail("cannot fork: $!");
1113 } elsif ($pid == 0) {
1114 open STDOUT, '>/dev/null' or fail("cannot reopen stdout: $!");
1115 open STDERR, '>&STDOUT' or fail("cannot reopen stderr: $!");
1116 exec $interpreter, '-n', $script
1117 or fail("cannot exec $interpreter: $!");
1124 sub remove_comments {
1127 my $line = shift || '';
1130 # Remove quoted strings so we can more easily ignore comments
1132 s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g;
1133 s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g;
1135 # If the remaining string contains what looks like a comment,
1136 # eat it. In either case, swap the unmodified script line
1137 # back in for processing (if required) and return it.
1138 if (m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) {
1140 s/\Q$1\E//; # eat comments
1149 my ($string, $replace_regex) = @_;
1152 if ($replace_regex) {
1153 $string =~ s,\.\+,*,g;
1162 # indent-tabs-mode: t
1163 # cperl-indent-level: 4
1165 # vim: syntax=perl ts=8 sw=4