--- /dev/null
+# scripts -- lintian check script -*- perl -*-
+#
+# This is probably the right file to add a check for the use of
+# set -e in bash and sh scripts.
+#
+# Copyright (C) 1998 Richard Braakman
+# Copyright (C) 2002 Josip Rodin
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Lintian::scripts;
+use strict;
+use Dep;
+use Tags;
+use Util;
+
+# This is a map of all known interpreters. The key is the interpreter name
+# (the binary invoked on the #! line). The value is an anonymous array of one
+# or two elements. The first, mandatory argument is the path on a Debian
+# system where that interpreter would be installed. The second, optional
+# argument is the dependency that provides that interpreter. If the second
+# argument isn't given, the package name is assumed to be the same as the
+# interpreter name. (Saves some typing.)
+#
+# Some interpreters list empty dependencies (as opposed to undefined ones).
+# Those interpreters should not have any dependency for one reason or another
+# (usually because they're essential packages or aren't used in a normal way).
+#
+# Do not list versioned patterns here (such as pythonX.Y, rubyX.Y, etc.). For
+# those, see %versioned_interpreters below.
+our %interpreters =
+ (ash => [ '/bin' ],
+ awk => [ '/usr/bin', '' ],
+ bash => [ '/bin', '' ],
+ bltwish => [ '/usr/bin', 'blt' ],
+ clisp => [ '/usr/bin' ],
+ csh => [ '/bin', 'tcsh | csh | c-shell' ],
+ dash => [ '/bin' ],
+ expect => [ '/usr/bin' ],
+ expectk => [ '/usr/bin' ],
+ fish => [ '/usr/bin' ],
+ gawk => [ '/usr/bin' ],
+ gbr2 => [ '/usr/bin', 'gambas2-runtime' ],
+ gbx => [ '/usr/bin', 'gambas-runtime' ],
+ gbx2 => [ '/usr/bin', 'gambas2-runtime' ],
+ gforth => [ '/usr/bin' ],
+ gnuplot => [ '/usr/bin' ],
+ gosh => [ '/usr/bin', 'gauche' ],
+ 'install-menu' => [ '/usr/bin', '' ],
+ jed => [ '/usr/bin' ],
+ 'jed-script' => [ '/usr/bin', 'jed | xjed' ],
+ kaptain => [ '/usr/bin' ],
+ ksh => [ '/bin', 'mksh | pdksh' ],
+ lefty => [ '/usr/bin', 'graphviz' ],
+ magicfilter => [ '/usr/sbin' ],
+ make => [ '/usr/bin', 'make | build-essential' ],
+ mawk => [ '/usr/bin' ],
+ ocamlrun => [ '/usr/bin',
+ 'ocaml-base-nox | ocaml-base | ocaml-nox | ocaml' ],
+ pagsh => [ '/usr/bin', 'openafs-client | heimdal-clients' ],
+ parrot => [ '/usr/bin' ],
+ perl => [ '/usr/bin', '' ],
+ procmail => [ '/usr/bin' ],
+ python => [ '/usr/bin', 'python | python-minimal' ],
+ pforth => [ '/usr/bin' ],
+ rc => [ '/usr/bin' ],
+ regina => [ '/usr/bin', 'regina-rexx' ],
+ rexx => [ '/usr/bin', 'regina-rexx' ],
+ rrdcgi => [ '/usr/bin', 'rrdtool' ],
+ ruby => [ '/usr/bin' ],
+ runhugs => [ '/usr/bin', 'hugs | hugs98' ],
+ sed => [ '/bin', '' ],
+ sh => [ '/bin', '' ],
+ slsh => [ '/usr/bin' ],
+ speedy => [ '/usr/bin', 'speedy-cgi-perl' ],
+ tcsh => [ '/usr/bin' ],
+ tixwish => [ '/usr/bin', 'tix' ],
+ trs => [ '/usr/bin', 'konwert' ],
+ xjed => [ '/usr/bin', 'xjed' ],
+ yforth => [ '/usr/bin', 'yforth' ],
+ yorick => [ '/usr/bin' ],
+ zsh => [ '/bin', 'zsh | zsh-beta' ],
+ );
+
+# The more complex case of interpreters that may have a version number.
+#
+# This is a hash from the base interpreter name to a list. The base
+# interpreter name may appear by itself or followed by some combination of
+# dashes, digits, and periods. The values are the directory in which the
+# interpreter is found, the dependency to add for a version-less interpreter,
+# a regular expression to match versioned interpreters and extract the version
+# number, the package dependency for a versioned interpreter, and the list of
+# known versions.
+#
+# An interpreter with a version must have a dependency on the specific package
+# formed by taking the fourth element of the list and replacing $1 with the
+# version number. An interpreter without a version is rejected if the second
+# element is undef; otherwise, the package must depend on the disjunction of
+# the second argument (if non-empty) and all the packages formed by taking the
+# list of known versions (the fifth element and on) and replacing $1 in the
+# fourth argument with them.
+#
+# For example:
+#
+# lua => [ '/usr/bin', 'lua', qr/^lua([\d.]+)$/, 'lua$1', qw(40 50 5.1) ]
+#
+# says that any lua interpreter must be in /usr/bin, a package using
+# /usr/bin/lua50 must depend on lua50, and a package using just /usr/bin/lua
+# must satisfy lua | lua40 | lusa50 | lua5.1.
+#
+# The list of known versions is the largest maintenance headache here, but
+# it's only used for the unversioned dependency handling, and then only when
+# someone uses the unversioned script but depends on a specific version for
+# some reason. So it's not a huge problem if it's a little out of date.
+our %versioned_interpreters =
+ (guile => [ '/usr/bin', 'guile',
+ qr/^guile-([\d.]+)$/, 'guile-$1', qw(1.6 1.8)
+ ],
+ jruby => [ '/usr/bin', undef,
+ qr/^jruby([\d.]+)$/, 'jruby$1', qw(0.9 1.0)
+ ],
+ lua => [ '/usr/bin', 'lua',
+ qr/^lua([\d.]+)$/, 'lua$1', qw(40 50 5.1)
+ ],
+ octave => [ '/usr/bin', 'octave',
+ qr/^octave([\d.]+)$/, 'octave$1', qw(2.1 2.9 3.0)
+ ],
+ php => [ '/usr/bin', '',
+ qr/^php(\d+)$/, 'php$1-cli', qw(4 5)
+ ],
+ pike => [ '/usr/bin', '',
+ qr/^pike([\d.]+)$/, 'pike$1 | pike$1-core', qw(7.6 7.7)
+ ],
+ python => [ '/usr/bin', undef,
+ qr/^python([\d.]+)$/, 'python$1 | python$1-minimal',
+ qw(2.4 2.5)
+ ],
+ ruby => [ '/usr/bin', undef,
+ qr/^ruby([\d.]+)$/, 'ruby$1', qw(1.8 1.9)
+ ],
+ scsh => [ '/usr/bin', 'scsh',
+ qr/^scsh-([\d.]+)$/, 'scsh-$1', qw(0.6)
+ ],
+ tclsh => [ '/usr/bin', 'tclsh | tcl',
+ qr/^tclsh([\d.]+)$/, 'tcl$1', qw(8.3 8.4 8.5)
+ ],
+ wish => [ '/usr/bin', 'wish | tk',
+ qr/^wish([\d.]+)$/, 'tk$1', qw(8.3 8.4 8.5)
+ ],
+ );
+
+# Any of the following packages can satisfy an update-inetd dependency.
+our $update_inetd
+ = join (' | ', qw(update-inetd inet-superserver openbsd-inetd
+ inetutils-inetd rlinetd xinetd));
+
+# Appearance of one of these regexes in a maintainer script means that there
+# must be a dependency (or pre-dependency) on the given package. The tag
+# reported is maintainer-script-needs-depends-on-%s, so be sure to update
+# scripts.desc when adding a new rule.
+our @depends_needed = (
+ [ adduser => '\badduser\b' ],
+ [ gconf2 => '\bgconf-schemas\b' ],
+ [ $update_inetd => '\bupdate-inetd\b' ],
+ [ ucf => '\bucf\s' ],
+ [ 'xml-core' => '\bupdate-xmlcatalog\b' ],
+);
+
+sub run {
+
+my %executable = ();
+my %suid = ();
+my %ELF = ();
+my %scripts = ();
+my %deps = ();
+
+# no dependency for install-menu, because the menu package specifically
+# says not to depend on it.
+
+my $pkg = shift;
+my $type = shift;
+
+open(INDEX, '<', "index") or fail("cannot open lintian index file: $!");
+while (<INDEX>) {
+ next unless (m/^-[rw-]*[xs]/);
+ chop;
+ s/ link to .*//;
+ my $is_suid = m/^-[rw-]*s/;
+ $executable{(split(' ', $_, 6))[5]} = 1;
+ $suid{(split(' ', $_, 6))[5]} = $is_suid;
+}
+close(INDEX);
+
+# Urgle... this is ambiguous, since the sequence ": " can occur in
+# the output of file and also in the filename.
+# Fortunately no filenames containing ": " currently occur in Debian packages.
+open(FILEINFO, '<', "file-info")
+ or fail("cannot open lintian file-info file: $!");
+while (<FILEINFO>) {
+ m/^(.*?): (.*)/ or fail("bad line in file-info: $_");
+ my $file = $1;
+ $ELF{$file} = 1 if $2 =~ /^[^,]*\bELF\b/o;
+}
+close(FILEINFO);
+
+my $all_deps = '';
+for my $field (qw/suggests recommends depends pre-depends provides/) {
+ $deps{$field} = '';
+ if (open(IN, '<', "fields/$field")) {
+ $_ = join('', <IN>);
+ close(IN);
+ chomp;
+ $deps{$field} = $_;
+ $all_deps .= ', ' if $all_deps;
+ $all_deps .= $_;
+ }
+ $deps{$field} = Dep::parse($deps{$field});
+}
+$all_deps .= ', ' if $all_deps;
+$all_deps .= $pkg;
+$deps{all} = Dep::parse($all_deps);
+
+open(SCRIPTS, '<', "scripts") or fail("cannot open lintian scripts file: $!");
+while (<SCRIPTS>) {
+ chop;
+
+ # This used to be split(' ', $_, 2), but that didn't handle empty
+ # interpreter lines correctly.
+ my ($calls_env, $interpreter, $filename) = m/^(env )?(\S*) (.*)$/ or
+ fail("bad line in scripts file: $_");
+
+ $scripts{$filename} = 1;
+
+ # no checks necessary at all for scripts in /usr/share/doc/
+ next if $filename =~ m,usr/share/doc/,;
+
+ my ($base) = $interpreter =~ m,([^/]*)$,;
+
+ # allow exception for .in files that have stuff like #!@PERL@
+ next if ($filename =~ m,\.in$, and $interpreter =~ m,^(\@|<\<)[A-Z_]+(\@|>\>)$,);
+
+ my $is_absolute = ($interpreter =~ m,^/, or defined $calls_env);
+
+ # Skip files that have the #! line, but are not executable and do not have
+ # an absolute path and are not in a bin/ directory (/usr/bin, /bin etc)
+ # They are probably not scripts after all.
+ next if ($filename !~ m,(bin/|etc/init.d/), and !$executable{$filename}
+ and !$is_absolute);
+
+ if ($interpreter eq "") {
+ tag("script-without-interpreter", $filename);
+ next;
+ }
+
+ # Either they use an absolute path or they use '/usr/bin/env interp'.
+ tag("interpreter-not-absolute", $filename, "#!$interpreter")
+ unless $is_absolute;
+ tag("script-not-executable", $filename)
+ unless ($executable{$filename}
+ or $filename =~ m,^\./usr/(lib|share)/.*\.pm,
+ or $filename =~ m,^\./usr/(lib|share)/.*\.py,
+ or $filename =~ m,^\./usr/(lib|share)/ruby/.*\.rb,
+ or $filename =~ m,\.in$,
+ or $filename =~ m,\.ex$,
+ or $filename eq './etc/init.d/skeleton'
+ or $filename =~ m,^\./etc/menu-methods,
+ or $filename =~ m,^\./etc/X11/Xsession.d,);
+
+ # Warn about csh scripts.
+ tag("csh-considered-harmful", $filename)
+ if (($base eq 'csh' or $base eq 'tcsh')
+ and $executable{$filename}
+ and $filename !~ m,^./etc/csh/login.d/,);
+
+ # Syntax-check most shell scripts, but don't syntax-check scripts that end
+ # in .dpatch. bash -n doesn't stop checking at exit 0 and goes on to blow
+ # up on the patch itself.
+ # zsh -n is broken, see #485885
+ if ($base =~ /^(?:(?:b|d)?a|k)?sh$/) {
+ if (-x "$interpreter" && ! script_is_evil_and_wrong("unpacked/$filename")) {
+ if ($filename !~ m,\.dpatch$,) {
+ if (check_script_syntax($interpreter, "unpacked/$filename")) {
+ tag("shell-script-fails-syntax-check", $filename);
+ }
+ }
+ }
+ }
+
+ # Try to find the expected path of the script to check. First check
+ # %interpreters and %versioned_interpreters. If not found there, see if
+ # it ends in a version number and the base is found in
+ # %versioned_interpreters.
+ my $data = $interpreters{$base};
+ my $versioned = 0;
+ if (not defined $data) {
+ $data = $versioned_interpreters{$base};
+ undef $data if ($data and not defined ($data->[1]));
+ if (not defined ($data) and $base =~ /^(.*[^\d.-])-?[\d.]+$/) {
+ $data = $versioned_interpreters{$1};
+ undef $data unless ($data and $base =~ /$data->[2]/);
+ }
+ $versioned = 1 if $data;
+ }
+ if ($data) {
+ my $expected = $data->[0] . '/' . $base;
+ unless ($interpreter eq $expected or defined $calls_env) {
+ tag("wrong-path-for-interpreter",
+ "#!$interpreter != $expected", "($filename)");
+ }
+ } elsif ($interpreter =~ m,/usr/local/,) {
+ tag("interpreter-in-usr-local", $filename, "#!$interpreter");
+ } elsif ($executable{'.' . $interpreter}) {
+ # Package installs the interpreter itself, so it's probably ok. Don't
+ # emit any tag for this.
+ } elsif ($base eq 'suidperl') {
+ tag("calls-suidperl-directly", $filename);
+ } elsif ($interpreter eq '/bin/env') {
+ tag("script-uses-bin-env", $filename);
+ } else {
+ tag("unusual-interpreter", $filename, "#!$interpreter");
+ }
+
+ # If we found the interpreter and the script is executable, check
+ # dependencies. This should be the last thing we do in the loop so that
+ # we can use next for an early exit and reduce the nesting.
+ next unless ($data && $executable{$filename});
+ if (!$versioned) {
+ my $depends = $data->[1];
+ if (not defined $depends) {
+ $depends = $base;
+ }
+ if ($depends && !Dep::implies($deps{all}, Dep::parse($depends))) {
+ if ($base =~ /^(python|ruby|(m|g)awk)$/) {
+ tag("$base-script-but-no-$base-dep", $filename);
+ } elsif ($base eq 'csh' && $filename =~ m,^\./etc/csh/login.d/,) {
+ # Initialization files for csh.
+ } elsif ($base eq 'fish' && $filename =~ m,^./etc/fish.d/,) {
+ # Initialization files for fish.
+ } else {
+ tag('missing-dep-for-interpreter', "$base => $depends",
+ "($filename)");
+ }
+ }
+ if ($base eq 'perl' && $suid{$filename}) {
+ tag("suid-perl-script-but-no-perl-suid-dep", $filename)
+ unless Dep::implies($deps{all}, Dep::parse('perl-suid'));
+ }
+ } elsif ($versioned_interpreters{$base}) {
+ my @versions = @$data[4 .. @$data - 1];
+ my @depends = map {
+ my $d = $data->[3];
+ $d =~ s/\$1/$_/g;
+ $d;
+ } @versions;
+ my $depends = join (' | ', $data->[1], @depends);
+ unless (Dep::implies($deps{all}, Dep::parse($depends))) {
+ if ($base eq 'php') {
+ tag('php-script-but-no-phpX-cli-dep', $filename);
+ } elsif ($base =~ /^(wish|tclsh)/) {
+ tag("$1-script-but-no-$1-dep", $filename);
+ } else {
+ tag("missing-dep-for-interpreter", "$base => $depends",
+ "($filename)");
+ }
+ }
+ } else {
+ my ($version) = ($base =~ /$data->[2]/);
+ my $depends = $data->[3];
+ $depends =~ s/\$1/$version/g;
+ unless (Dep::implies($deps{all}, Dep::parse($depends))) {
+ if ($base =~ /^php/) {
+ tag('php-script-but-no-phpX-cli-dep', $filename);
+ } elsif ($base =~ /^(python|ruby)/) {
+ tag("$1-script-but-no-$1-dep", $filename);
+ } else {
+ tag("missing-dep-for-interpreter", "$base => $depends",
+ "($filename)");
+ }
+ }
+ }
+}
+close(SCRIPTS);
+
+foreach (keys %executable) {
+ tag("executable-not-elf-or-script", $_)
+ unless ( $ELF{$_}
+ or $scripts{$_}
+ or $_ =~ m,^usr(/X11R6)?/man/,
+ or $_ =~ m/\.exe$/ # mono convention
+ );
+}
+
+open(SCRIPTS, '<', "control-scripts")
+ or fail("cannot open lintian control-scripts file: $!");
+
+# Handle control scripts. This is an edited version of the code for
+# normal scripts above, because there were just enough differences to
+# make a shared function awkward.
+
+while (<SCRIPTS>) {
+ chop;
+
+ m/^(\S*) (.*)$/ or fail("bad line in control-scripts file: $_");
+ my $interpreter = $1;
+ my $file = $2;
+ my $filename = "control/$file";
+
+ $interpreter =~ m|([^/]*)$|;
+ my $base = $1;
+
+ if ($interpreter eq "") {
+ tag("script-without-interpreter", $filename);
+ next;
+ }
+
+ tag("interpreter-not-absolute", $filename, "#!$interpreter")
+ unless ($interpreter =~ m|^/|);
+
+ if (exists $interpreters{$base}) {
+ my $data = $interpreters{$base};
+ my $expected = $data->[0] . '/' . $base;
+ tag("wrong-path-for-interpreter", "#!$interpreter != $expected",
+ "($filename)")
+ unless ($interpreter eq $expected);
+ unless ($base eq 'sh' or $base eq 'bash' or $base eq 'perl') {
+ my $tag;
+ if ($file eq 'config') {
+ $tag = 'forbidden-config-interpreter';
+ } else {
+ $tag = 'unusual-control-interpreter';
+ }
+ tag($tag, "#!$interpreter");
+ }
+ unless (defined ($data->[1]) and not $data->[1]) {
+ my $depends = $data->[1] || $base;
+ unless (Dep::implies($deps{'pre-depends'}, Dep::parse($depends))) {
+ tag("interpreter-without-predep", $filename, "#!$interpreter");
+ }
+ }
+ } elsif ($interpreter =~ m|/usr/local/|) {
+ tag("interpreter-in-usr-local", $filename, "#!$interpreter");
+ } else {
+ tag("unusual-interpreter", $filename, "#!$interpreter");
+ next; # no use doing further checks if it's not a known interpreter
+ }
+
+ # perhaps we should warn about *csh even if they're somehow screwed,
+ # but that's not really important...
+ tag("csh-considered-harmful", $filename)
+ if ($base eq 'csh' or $base eq 'tcsh');
+
+ my $shellscript = $base =~ /^((b|d)?a|t?c|(pd)?k)?sh$/ ? 1 : 0;
+
+ # Only syntax-check scripts we can check with bash.
+ my $checkbashisms;
+ if ($shellscript) {
+ $checkbashisms = $base eq "sh" ? 1 : 0;
+ if ($base eq 'sh' or $base eq 'bash') {
+ if (check_script_syntax("/bin/bash", $filename)) {
+ tag("maintainer-shell-script-fails-syntax-check", $file);
+ }
+ }
+ }
+
+ # now scan the file contents themselves
+ open (C, '<', "$filename")
+ or fail("cannot open maintainer script $filename for reading: $!");
+
+ my %warned;
+ my ($saw_init, $saw_invoke, $saw_debconf, $has_code);
+ my $cat_string = "";
+
+ while (<C>) {
+ next if m,^\s*$,; # skip empty lines
+ next if m,^\s*\#,; # skip comment lines
+ s/\#.*$//; # eat comments
+ chomp();
+
+ # Don't consider the standard dh-make boilerplate to be code. This
+ # means ignoring the framework of a case statement, the labels, the
+ # echo complaining about unknown arguments, and an exit.
+ unless ($has_code
+ || m/^\s*set\s+-\w+\s*$/
+ || m/^\s*case\s+\"?\$1\"?\s+in\s*$/
+ || m/^\s*(?:[a-z|-]+|\*)\)\s*$/
+ || m/^\s*[:;]+\s*$/
+ || m/^\s*echo\s+\"[^\"]+\"(?:\s*>&2)?\s*$/
+ || m/^\s*esac\s*$/
+ || m/^\s*exit\s+\d+\s*$/) {
+ $has_code = 1;
+ }
+
+ 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/) {
+ tag "possibly-insecure-handling-of-tmp-files-in-maintainer-script", "$file:$."
+ unless $warned{tmp};
+ $warned{tmp} = 1;
+ }
+ if (m/^\s*killall(?:\s|\z)/) {
+ tag "killall-is-dangerous", "$file:$." unless $warned{killall};
+ $warned{killall} = 1;
+ }
+ if (m/^\s*mknod(?:\s|\z)/ and not m/\sp\s/) {
+ tag "mknod-in-maintainer-script", "$file:$.";
+ }
+
+ # Collect information about init script invocations to catch running
+ # init scripts directory rather than through invoke-rc.d. Since the
+ # script is allowed to run the init script directly if invoke-rc.d
+ # doesn't exist, only tag direct invocations where invoke-rc.d is
+ # never used in the same script. Lots of false negatives, but
+ # hopefully not many false positives.
+ if (m%^\s*/etc/init.d/(\S+)\s+[\"\']?(\S+)[\"\']?%) {
+ $saw_init = $.;
+ }
+ if (m%^\s*invoke-rc.d\s+%) {
+ $saw_invoke = $.;
+ }
+
+ if ($shellscript) {
+ if ($cat_string ne "" and m/^\Q$cat_string\E$/) {
+ $cat_string = "";
+ }
+ my $within_another_shell = 0;
+ if (m,(^|\s+)((/usr)?/bin/)?((b|d)?a|k|z|t?c)sh\s+-c\s*.+,) {
+ $within_another_shell = 1;
+ }
+ # if cat_string is set, we are in a HERE document and need not
+ # check for things
+ if ($cat_string eq "" and $checkbashisms and !$within_another_shell) {
+ my $found = 0;
+ my $match = '';
+ my $LEADIN = qr'(?:(^|[`&;(|{])\s*|(if|then|do|while)\s+)';
+ my @bashism_single_quote_regexs = (
+ $LEADIN . qr'echo\s+(?:-[^e\s]+\s+)?\'[^\']*(\\[\\abcEfnrtv0])+.*?[\']',
+ # unsafe echo with backslashes
+ );
+ my @bashism_string_regexs = (
+ qr'\$\[\w+\]', # arith not allowed
+ qr'\$\{\w+\:\d+(?::\d+)?\}', # ${foo:3[:1]}
+ qr'\$\{\w+(/.+?){1,2}\}', # ${parm/?/pat[/str]}
+ qr'\$\{\#?\w+\[[0-9\*\@]+\]\}',# bash arrays, ${name[0|*|@]}
+ qr'\$\{!\w+[\@*]\}', # ${!prefix[*|@]}
+ qr'\$\{!\w+\}', # ${!name}
+ qr'(\$\(|\`)\s*\<\s*\S+\s*(\)|\`)', # $(\< foo) should be $(cat foo)
+ qr'\$\{?RANDOM\}?\b', # $RANDOM
+ qr'\$\{?(OS|MACH)TYPE\}?\b', # $(OS|MACH)TYPE
+ qr'\$\{?HOST(TYPE|NAME)\}?\b', # $HOST(TYPE|NAME)
+ qr'\$\{?DIRSTACK\}?\b', # $DIRSTACK
+ qr'\$\{?EUID\}?\b', # $EUID should be "id -u"
+ qr'\$\{?UID\}?\b', # $UID should be "id -ru"
+ qr'\$\{?SECONDS\}?\b', # $SECONDS
+ qr'\$\{?BASH_[A-Z]+\}?\b', # $BASH_SOMETHING
+ qr'\$\{?SHELLOPTS\}?\b', # $SHELLOPTS
+ qr'\$\{?PIPESTATUS\}?\b', # $PIPESTATUS
+ qr'\$\{?SHLVL\}?\b', # $SHLVL
+ qr'<<<', # <<< here string
+ $LEADIN . qr'echo\s+(?:-[^e\s]+\s+)?\"[^\"]*(\\[\\abcEfnrtv0])+.*?[\"]',
+ # unsafe echo with backslashes
+ );
+ my @bashism_regexs = (
+ qr'(?:^|\s+)function \w+(\s|\(|\Z)', # function is useless
+ # should be '.', not 'source'
+ $LEADIN . qr'source\s+(?:\.\/|\/|\$)[^\s]+',
+ qr'(test|-o|-a)\s*[^\s]+\s+==\s', # should be 'b = a'
+ qr'\[\s+[^\]]+\s+==\s', # should be 'b = a'
+ qr'\s(\|\&)', # pipelining is not POSIX
+ qr'[^\\\$]\{(?:[^\s\\\}]+?,)+[^\\\}\s]+\}', # brace expansion
+ qr'(?:^|\s+)\w+\[\d+\]=', # bash arrays, H[0]
+ $LEADIN . qr'(read\s*(-[^r]+)*(?:;|$))',
+ # read without variable or with option other than -r
+ $LEADIN . qr'kill\s+-[^sl]\w*',# kill -[0-9] or -[A-Z]
+ $LEADIN . qr'trap\s+["\']?.*["\']?\s+.*[1-9]', # trap with signal numbers
+ qr'\&>', # cshism
+ qr'(<\&|>\&)\s*((-|\d+)[^\s;|)`&\\\\]|[^-\d\s]+)', # should be >word 2>&1
+ qr'\[\[(?!:)', # alternative test command
+ $LEADIN . qr'select\s+\w+', # 'select' is not POSIX
+ $LEADIN . qr'echo\s+(-n\s+)?-n?en?', # echo -e
+ $LEADIN . qr'exec\s+-[acl]', # exec -c/-l/-a name
+ qr'(?:^|\s+)let\s', # let ...
+ qr'(?<![\$\(])\(\(.*\)\)', # '((' should be '$(('
+ qr'\$\[[^][]+\]', # '$[' should be '$(('
+ qr'(\[|test)\s+-a', # test with unary -a (should be -e)
+ qr'/dev/(tcp|udp)', # /dev/(tcp|udp)
+ $LEADIN . qr'\w+\+=', # should be "VAR="${VAR}foo"
+ $LEADIN . qr'suspend\s',
+ $LEADIN . qr'caller\s',
+ $LEADIN . qr'complete\s',
+ $LEADIN . qr'compgen\s',
+ $LEADIN . qr'declare\s',
+ $LEADIN . qr'typeset\s',
+ $LEADIN . qr'disown\s',
+ $LEADIN . qr'builtin\s',
+ $LEADIN . qr'set\s+-[BHT]+', # set -[BHT]
+ $LEADIN . qr'alias\s+-p', # alias -p
+ $LEADIN . qr'unalias\s+-a', # unalias -a
+ $LEADIN . qr'local\s+-[a-zA-Z]+', # local -opt
+ $LEADIN . qr'local\s+\w+=', # local foo=bar
+ qr'(?:^|\s+)\s*\(?\w*[^\(\w\s]+\S*?\s*\(\)\s*([\{|\(]|\Z)',
+ # function names should only contain [a-z0-9_]
+ $LEADIN . qr'(push|pop)d(\s|\Z)', # (push|pod)d
+ $LEADIN . qr'export\s+-[^p]', # export only takes -p as an option
+ $LEADIN . qr'ulimit(\s|\Z)',
+ $LEADIN . qr'shopt(\s|\Z)',
+ $LEADIN . qr'type\s',
+ $LEADIN . qr'time\s',
+ $LEADIN . qr'dirs(\s|\Z)',
+ qr'(?:^|\s+)[<>]\(.*?\)', # <() process substituion
+ qr'(?:^|\s+)readonly\s+-[af]', # readonly -[af]
+ $LEADIN . qr'(sh|\$\{?SHELL\}?) -[rD]', # sh -[rD]
+ $LEADIN . qr'(sh|\$\{?SHELL\}?) --\w+', # sh --long-option
+ $LEADIN . qr'(sh|\$\{?SHELL\}?) [-+]O', # sh [-+]O
+ );
+
+ # since this test is ugly, I have to do it by itself
+ # detect source (.) trying to pass args to the command it runs
+ # The first expression weeds out '. "foo bar"'
+ if (not $found and
+ not m/^\s*\.\s+(\"[^\"]+\"|\'[^\']+\')\s*(\&|\||\d?>|<|;|\Z)/
+ and m/^\s*(\.\s+[^\s;\`:]+\s+([^\s;]+))/) {
+
+ my $extra;
+ ($match, $extra) = ($1, $2);
+ if ($extra =~ /^(\&|\||\d?>|<)/) {
+ # everything is ok
+ ;
+ } else {
+ $found = 1;
+ }
+ }
+
+ my $line = $_;
+
+ unless ($found) {
+ for my $re (@bashism_single_quote_regexs) {
+ if ($line =~ m/($re)/) {
+ $found = 1;
+ ($match) = m/($re)/;
+ last;
+ }
+ }
+ }
+
+ # Ignore anything inside single quotes; it could be an
+ # argument to grep or the like.
+
+ # $cat_line contains the version of the line we'll check
+ # for heredoc delimiters later. Initially, remove any
+ # spaces between << and the delimiter to make the following
+ # updates to $cat_line easier.
+ my $cat_line = $line;
+ $cat_line =~ s/(<\<-?)\s+/$1/g;
+
+ # Remove single quoted strings, with the exception that we
+ # don't remove the string
+ # if the quote is immediately preceeded by a < or a -, so we
+ # can match "foo <<-?'xyz'" as a heredoc later
+ # The check is a little more greedy than we'd like, but the
+ # heredoc test itself will weed out any false positives
+ $cat_line =~ s/(^|[^<\\\"-](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g;
+
+ unless ($found) {
+ # Remove "quoted quotes". They're likely to be inside
+ # another pair of quotes; we're not interested in
+ # them for their own sake and removing them makes finding
+ # the limits of the outer pair far easier.
+ $line =~ s/(^|[^\\\'\"])\"\'\"/$1/g;
+ $line =~ s/(^|[^\\\'\"])\'\"\'/$1/g;
+
+ $line =~ s/(^|[^\\\"](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g;
+ for my $re (@bashism_string_regexs) {
+ if ($line =~ m/($re)/) {
+ $found = 1;
+ ($match) = m/($re)/;
+ last;
+ }
+ }
+ }
+
+ # We've checked for all the things we still want to notice in
+ # double-quoted strings, so now remove those strings as well.
+ $cat_line =~ s/(^|[^<\\\'-](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g;
+ unless ($found) {
+ $line =~ s/(^|[^\\\'](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g;
+ for my $re (@bashism_regexs) {
+ if ($line =~ m/($re)/) {
+ $found = 1;
+ ($match) = m/($re)/;
+ last;
+ }
+ }
+ }
+
+ if ($found) {
+ tag "possible-bashism-in-maintainer-script", "$file:$. \'$match\'";
+ }
+
+ # Only look for the beginning of a heredoc here, after we've
+ # stripped out quoted material, to avoid false positives.
+ if ($cat_line =~ m/(?:^|[^<])\<\<\-?\s*(?:[\\]?(\w+)|[\'\"](.*?)[\'\"])/) {
+ $cat_string = $1;
+ $cat_string = $2 if not defined $cat_string;
+ }
+ }
+ if (!$cat_string) {
+ if (/^\s*start-stop-daemon\s+/ && !/\s--stop\b/) {
+ tag 'start-stop-daemon-in-maintainer-script', "$file:$.";
+ }
+ # Don't use chown foo.bar
+ if (/(chown(\s+--?[A-Za-z-]+)*\s+[-_A-Za-z0-9]+\.[-_A-Za-z0-9]+)\s+/) {
+ tag "deprecated-chown-usage", "$file:$. \'$1\'";
+ }
+ if (/invoke-rc.d.*\|\| exit 0/) {
+ tag "maintainer-script-hides-init-failure", "$file:$.";
+ }
+ if (m,/usr/share/debconf/confmodule,) {
+ $saw_debconf = 1;
+ }
+ if (m/^\s*read(?:\s|\z)/ && !$saw_debconf) {
+ tag "read-in-maintainer-script", "$file:$.";
+ }
+ if (m,^\s*rm\s+([^>]*\s)?/dev/,) {
+ tag "maintainer-script-removes-device-files", "$file:$.";
+ }
+ if (m,>\s*(/etc/(?:services|protocols|rpc))(\s|\Z),) {
+ tag "maintainer-script-modifies-netbase-managed-file", "$file:$. $1";
+ }
+ if (m,^\s*(?:cp|mv)\s.*(/etc/(?:services|protocols|rpc))\s*$,) {
+ tag "maintainer-script-modifies-netbase-managed-file", "$file:$. $1";
+ }
+ if (m,>\s*/etc/inetd\.conf(\s|\Z),) {
+ tag "maintainer-script-modifies-inetd-conf", "$file:$."
+ unless Dep::implies($deps{provides}, Dep::parse('inet-superserver'));
+ }
+ if (m,^\s*(?:cp|mv)\s+(?:.*\s)?/etc/inetd\.conf\s*$,) {
+ tag "maintainer-script-modifies-inetd-conf", "$file:$."
+ unless Dep::implies($deps{provides}, Dep::parse('inet-superserver'));
+ }
+
+ # Ancient dpkg feature tests.
+ if (m/^\s*dpkg\s+--assert-support-predepends\b/) {
+ tag "ancient-dpkg-predepends-check", "$file:$.";
+ }
+ if (m/^\s*dpkg\s+--assert-working-epoch\b/) {
+ tag "ancient-dpkg-epoch-check", "$file:$.";
+ }
+ if (m/^dpkg\s+--assert-long-filenames\b/) {
+ tag "ancient-dpkg-long-filenames-check", "$file:$.";
+ }
+ if (m/^dpkg\s+--assert-multi-conrep\b/) {
+ tag "ancient-dpkg-multi-conrep-check", "$file:$.";
+ }
+ }
+ }
+ if (m,\bsuidregister\b,) {
+ tag "suidregister-used-in-maintainer-script", "$file";
+ }
+ if ($file eq 'postrm') {
+ if (m,update\-alternatives \-\-remove,) {
+ tag "update-alternatives-remove-called-in-postrm", "";
+ }
+ } else {
+ for my $rule (@depends_needed) {
+ my ($package, $regex) = @$rule;
+ if ($pkg ne $package and /$regex/ and ! $warned{$package}) {
+ if (m,-x\s+\S*$regex, or m,which\s+$regex, or m,command\s+.*?$regex,) {
+ $warned{$package} = 1;
+ } else {
+ my $needed = Dep::parse($package);
+ unless (Dep::implies($deps{depends}, $needed) || Dep::implies($deps{'pre-depends'}, $needed)) {
+ my $shortpackage = $package;
+ $shortpackage =~ s/[ \(].*//;
+ tag "maintainer-script-needs-depends-on-$shortpackage", "$file";
+ $warned{$package} = 1;
+ }
+ }
+ }
+ }
+ }
+ if (m,\bgconftool(-2)?(\s|\Z),) {
+ tag "gconftool-used-in-maintainer-script", "$file:$.";
+ }
+ if (m,\binstall-sgmlcatalog\b, && !(m,--remove, && ($file eq 'prerm' || $file eq 'postinst'))) {
+ tag "install-sgmlcatalog-deprecated", "$file:$.";
+ }
+ if (m,/var/lib/dpkg/status\b, && $pkg ne 'base-files' && $pkg ne 'dpkg') {
+ tag "maintainer-script-uses-dpkg-status-directly", "$file";
+ }
+ }
+
+ if ($saw_init && ! $saw_invoke) {
+ tag "maintainer-script-calls-init-script-directly", "$file:$saw_init";
+ }
+ unless ($has_code) {
+ tag "maintainer-script-empty", $file;
+ }
+
+ close C;
+
+}
+close(SCRIPTS);
+
+}
+
+# -----------------------------------
+
+# Returns non-zero if the given file is not actually a shell script,
+# just looks like one.
+sub script_is_evil_and_wrong {
+ my ($filename) = @_;
+ my $ret = 0;
+ open (IN, '<', $filename) or fail("cannot open $filename: $!");
+ my $i = 0;
+ my $var = "0";
+ my $backgrounded = 0;
+ local $_;
+ while (<IN>) {
+ chomp;
+ next if m/^#/o;
+ next if m/^$/o;
+ last if (++$i > 55);
+ if (m~
+ # the exec should either be "eval"ed or a new statement
+ (^\s*|\beval\s*[\'\"]|(;|&&)\s*)
+
+ # eat anything between the exec and $0
+ exec\s*.+\s*
+
+ # optionally quoted executable name (via $0)
+ .?\$$var.?\s*
+
+ # optional "end of options" indicator
+ (--\s*)?
+
+ # Match expressions of the form '${1+$@}', '${1:+"$@"',
+ # '"${1+$@', "$@", etc where the quotes (before the dollar
+ # sign(s)) are optional and the second (or only if the $1
+ # clause is omitted) parameter may be $@ or $*.
+ #
+ # Finally the whole subexpression may be omitted for scripts
+ # which do not pass on their parameters (i.e. after re-execing
+ # they take their parameters (and potentially data) from stdin
+ .?(\${1:?\+.?)?(\$(\@|\*))?~x) {
+ $ret = 1;
+ last;
+ } elsif (/^\s*(\w+)=\$0;/) {
+ $var = $1;
+ } elsif (m~
+ # Match scripts which use "foo $0 $@ &\nexec true\n"
+ # Program name
+ \S+\s+
+
+ # As above
+ .?\$$var.?\s*
+ (--\s*)?
+ .?(\${1:?\+.?)?(\$(\@|\*))?.?\s*\&~x) {
+
+ $backgrounded = 1;
+ } elsif ($backgrounded and m~
+ # the exec should either be "eval"ed or a new statement
+ (^\s*|\beval\s*[\'\"]|(;|&&)\s*)
+ exec\s+true(\s|\Z)~x) {
+
+ $ret = $1;
+ last;
+ }
+ }
+ close IN;
+ return $ret;
+}
+
+# Given an interpretor and a file, run the interpretor on that file with the
+# -n option to check syntax, discarding output and returning the exit status.
+sub check_script_syntax {
+ my ($interpreter, $script) = @_;
+ my $pid = fork;
+ if (!defined $pid) {
+ fail("cannot fork: $!");
+ } elsif ($pid == 0) {
+ open STDOUT, '>/dev/null' or fail("cannot reopen stdout: $!");
+ open STDERR, '>&STDOUT' or fail("cannot reopen stderr: $!");
+ exec $interpreter, '-n', $script
+ or fail("cannot exec $interpreter: $!");
+ } else {
+ waitpid $pid, 0;
+ }
+ return $?;
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: t
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl ts=8 sw=4
projects / maemian / blobdiff