From d4db1cde70b0791229ff2704262e53e94e7c0dad Mon Sep 17 00:00:00 2001 From: ng0 Date: Tue, 19 Mar 2019 17:17:02 +0000 Subject: generate perl for checkbashisms.pl --- lint/checkbashisms.pl.in | 814 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 814 insertions(+) create mode 100755 lint/checkbashisms.pl.in (limited to 'lint/checkbashisms.pl.in') diff --git a/lint/checkbashisms.pl.in b/lint/checkbashisms.pl.in new file mode 100755 index 000000000..0b8b06f86 --- /dev/null +++ b/lint/checkbashisms.pl.in @@ -0,0 +1,814 @@ +#!@PERL@ + +# This script is essentially copied from /usr/share/lintian/checks/scripts, +# which is: +# Copyright (C) 1998 Richard Braakman +# Copyright (C) 2002 Josip Rodin +# This version is +# Copyright (C) 2003 Julian Gilbey +# +# 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, see . + +use strict; +use warnings; +use Getopt::Long qw(:config bundling permute no_getopt_compat); +use File::Temp qw/tempfile/; + +sub init_hashes; + +(my $progname = $0) =~ s|.*/||; + +my $usage = <<"EOF"; +Usage: $progname [-n] [-f] [-x] script ... + or: $progname --help + or: $progname --version +This script performs basic checks for the presence of bashisms +in /bin/sh scripts and the lack of bashisms in /bin/bash ones. +EOF + +my $version = <<"EOF"; +This is $progname, from the Debian devscripts package, version ###VERSION### +This code is copyright 2003 by Julian Gilbey , +based on original code which is copyright 1998 by Richard Braakman +and copyright 2002 by Josip Rodin. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2, or (at your option) any later version. +EOF + +my ($opt_echo, $opt_force, $opt_extra, $opt_posix); +my ($opt_help, $opt_version); +my @filenames; + +# Detect if STDIN is a pipe +if (scalar(@ARGV) == 0 && (-p STDIN or -f STDIN)) { + push(@ARGV, '-'); +} + +## +## handle command-line options +## +$opt_help = 1 if int(@ARGV) == 0; + +GetOptions( + "help|h" => \$opt_help, + "version|v" => \$opt_version, + "newline|n" => \$opt_echo, + "force|f" => \$opt_force, + "extra|x" => \$opt_extra, + "posix|p" => \$opt_posix, + ) + or die +"Usage: $progname [options] filelist\nRun $progname --help for more details\n"; + +if ($opt_help) { print $usage; exit 0; } +if ($opt_version) { print $version; exit 0; } + +$opt_echo = 1 if $opt_posix; + +my $mode = 0; +my $issues = 0; +my $status = 0; +my $makefile = 0; +my (%bashisms, %string_bashisms, %singlequote_bashisms); + +my $LEADIN + = qr'(?:(?:^|[`&;(|{])\s*|(?:(?:if|elif|while)(?:\s+!)?|then|do|shell)\s+)'; +init_hashes; + +my @bashisms_keys = sort keys %bashisms; +my @string_bashisms_keys = sort keys %string_bashisms; +my @singlequote_bashisms_keys = sort keys %singlequote_bashisms; + +foreach my $filename (@ARGV) { + my $check_lines_count = -1; + + my $display_filename = $filename; + + if ($filename eq '-') { + my $tmp_fh; + ($tmp_fh, $filename) + = tempfile("chkbashisms_tmp.XXXX", TMPDIR => 1, UNLINK => 1); + while (my $line = ) { + print $tmp_fh $line; + } + close($tmp_fh); + $display_filename = "(stdin)"; + } + + if (!$opt_force) { + $check_lines_count = script_is_evil_and_wrong($filename); + } + + if ($check_lines_count == 0 or $check_lines_count == 1) { + warn +"script $display_filename does not appear to be a /bin/sh script; skipping\n"; + next; + } + + if ($check_lines_count != -1) { + warn +"script $display_filename appears to be a shell wrapper; only checking the first " + . "$check_lines_count lines\n"; + } + + unless (open C, '<', $filename) { + warn "cannot open script $display_filename for reading: $!\n"; + $status |= 2; + next; + } + + $issues = 0; + $mode = 0; + my $cat_string = ""; + my $cat_indented = 0; + my $quote_string = ""; + my $last_continued = 0; + my $continued = 0; + my $found_rules = 0; + my $buffered_orig_line = ""; + my $buffered_line = ""; + my %start_lines; + + while () { + next unless ($check_lines_count == -1 or $. <= $check_lines_count); + + if ($. == 1) { # This should be an interpreter line + if (m,^\#!\s*(?:\S+/env\s+)?(\S+),) { + my $interpreter = $1; + + if ($interpreter =~ m,(?:^|/)make$,) { + init_hashes if !$makefile++; + $makefile = 1; + } else { + init_hashes if $makefile--; + $makefile = 0; + } + next if $opt_force; + + if ($interpreter =~ m,(?:^|/)bash$,) { + $mode = 1; + } elsif ($interpreter !~ m,(?:^|/)(sh|dash|posh)$,) { +### ksh/zsh? + warn +"script $display_filename does not appear to be a /bin/sh script; skipping\n"; + $status |= 2; + last; + } + } else { + warn +"script $display_filename does not appear to have a \#! interpreter line;\nyou may get strange results\n"; + } + } + + chomp; + my $orig_line = $_; + + # We want to remove end-of-line comments, so need to skip + # comments that appear inside balanced pairs + # of single or double quotes + + # Remove comments in the "quoted" part of a line that starts + # in a quoted block? The problem is that we have no idea + # whether the program interpreting the block treats the + # quote character as part of the comment or as a quote + # terminator. We err on the side of caution and assume it + # will be treated as part of the comment. + # s/^(?:.*?[^\\])?$quote_string(.*)$/$1/ if $quote_string ne ""; + + # skip comment lines + if ( m,^\s*\#, + && $quote_string eq '' + && $buffered_line eq '' + && $cat_string eq '') { + next; + } + + # Remove quoted strings so we can more easily ignore comments + # inside them + s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + + # If inside a quoted string, remove everything before the quote + s/^.+?\'// + if ($quote_string eq "'"); + s/^.+?[^\\]\"// + if ($quote_string eq '"'); + + # If the remaining string contains what looks like a comment, + # eat it. In either case, swap the unmodified script line + # back in for processing. + if (m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) { + $_ = $orig_line; + s/\Q$1\E//; # eat comments + } else { + $_ = $orig_line; + } + + # Handle line continuation + if (!$makefile && $cat_string eq '' && m/\\$/) { + chop; + $buffered_line .= $_; + $buffered_orig_line .= $orig_line . "\n"; + next; + } + + if ($buffered_line ne '') { + $_ = $buffered_line . $_; + $orig_line = $buffered_orig_line . $orig_line; + $buffered_line = ''; + $buffered_orig_line = ''; + } + + if ($makefile) { + $last_continued = $continued; + if (/[^\\]\\$/) { + $continued = 1; + } else { + $continued = 0; + } + + # Don't match lines that look like a rule if we're in a + # continuation line before the start of the rules + if (/^[\w%-]+:+\s.*?;?(.*)$/ + and !($last_continued and !$found_rules)) { + $found_rules = 1; + $_ = $1 if $1; + } + + last + if m%^\s*(override\s|export\s)?\s*SHELL\s*:?=\s*(/bin/)?bash\s*%; + + # Remove "simple" target names + s/^[\w%.-]+(?:\s+[\w%.-]+)*::?//; + s/^\t//; + s/(?|<|;|\Z)/o + and m/$LEADIN(\.\s+[^\s;\`:]+\s+([^\s;]+))/o) { + if ($2 =~ /^(\&|\||\d?>|<)/) { + # everything is ok + ; + } else { + $found = 1; + $match = $1; + $explanation = "sourced script with arguments"; + output_explanation($display_filename, $orig_line, + $explanation); + } + } + + # 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; + + foreach my $re (@singlequote_bashisms_keys) { + my $expl = $singlequote_bashisms{$re}; + if ($line =~ m/($re)/) { + $found = 1; + $match = $1; + $explanation = $expl; + output_explanation($display_filename, $orig_line, + $explanation); + } + } + + my $re = '(?); + } + } + + # $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. However, don't remove the + # spaces if the delimiter starts with a -, as that changes + # how the delimiter is searched. + my $cat_line = $line; + $cat_line =~ s/(<\<-?)\s+(?!-)/$1/g; + + # Ignore anything inside single quotes; it could be an + # argument to grep or the like. + $line =~ s/(^|[^\\\"](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g; + + # As above, with the exception that we don't remove the string + # if the quote is immediately preceded 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; + + $re = '(?); + } + } + + foreach my $re (@string_bashisms_keys) { + my $expl = $string_bashisms{$re}; + if ($line =~ m/($re)/) { + $found = 1; + $match = $1; + $explanation = $expl; + output_explanation($display_filename, $orig_line, + $explanation); + } + } + + # We've checked for all the things we still want to notice in + # double-quoted strings, so now remove those strings as well. + $line =~ s/(^|[^\\\'](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + $cat_line =~ s/(^|[^<\\\'-](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g; + foreach my $re (@bashisms_keys) { + my $expl = $bashisms{$re}; + if ($line =~ m/($re)/) { + $found = 1; + $match = $1; + $explanation = $expl; + output_explanation($display_filename, $orig_line, + $explanation); + } + } + # This check requires the value to be compared, which could + # be done in the regex itself but requires "use re 'eval'". + # So it's better done in its own + if ($line =~ m/$LEADIN((?:exit|return)\s+(\d{3,}))/o && $2 > 255) { + $explanation = 'exit|return status code greater than 255'; + output_explanation($display_filename, $orig_line, + $explanation); + } + + # 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*(?:(?!<|'|")((?:[^\s;>|]+(?:(?<=\\)[\s;>|])?)+)|[\'\"](.*?)[\'\"])/ + ) { + $cat_indented = ($1 && $1 eq '-') ? 1 : 0; + my $quoted = defined($3); + $cat_string = $quoted ? $3 : $2; + unless ($quoted) { + # Now strip backslashes. Keep the position of the + # last match in a variable, as s/// resets it back + # to undef, but we don't want that. + my $pos = 0; + pos($cat_string) = $pos; + while ($cat_string =~ s/\G(.*?)\\/$1/) { + # position += length of match + the character + # that followed the backslash: + $pos += length($1) + 1; + pos($cat_string) = $pos; + } + } + $start_lines{'cat_string'} = $.; + } + } + } + + warn +"error: $display_filename: Unterminated heredoc found, EOF reached. Wanted: <$cat_string>, opened in line $start_lines{'cat_string'}\n" + if ($cat_string ne ''); + warn +"error: $display_filename: Unterminated quoted string found, EOF reached. Wanted: <$quote_string>, opened in line $start_lines{'quote_string'}\n" + if ($quote_string ne ''); + warn "error: $display_filename: EOF reached while on line continuation.\n" + if ($buffered_line ne ''); + + close C; + + if ($mode && !$issues) { + warn "could not find any possible bashisms in bash script $filename\n"; + $status |= 4; + } +} + +exit $status; + +sub output_explanation { + my ($filename, $line, $explanation) = @_; + + if ($mode) { + # When examining a bash script, just flag that there are indeed + # bashisms present + $issues = 1; + } else { + warn "possible bashism in $filename line $. ($explanation):\n$line\n"; + $status |= 1; + } +} + +# 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 = -1; + # lintian's version of this function aborts if the file + # can't be opened, but we simply return as the next + # test in the calling code handles reporting the error + # itself + open(IN, '<', $filename) or return $ret; + my $i = 0; + my $var = "0"; + my $backgrounded = 0; + local $_; + while () { + chomp; + next if /^#/o; + next if /^$/o; + last if (++$i > 55); + if ( + m~ + # the exec should either be "eval"ed or a new statement + (^\s*|\beval\s*[\'\"]|(;|&&|\b(then|else))\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*[\'\"]|(;|&&|\b(then|else))\s*) + exec\s+true(\s|\Z)~x + ) { + + $ret = $. - 1; + last; + } elsif (m~\@DPATCH\@~) { + $ret = $. - 1; + last; + } + + } + close IN; + return $ret; +} + +sub init_hashes { + + %bashisms = ( + qr'(?:^|\s+)function [^<>\(\)\[\]\{\};|\s]+(\s|\(|\Z)' => + q<'function' is useless>, + $LEADIN . qr'select\s+\w+' => q<'select' is not POSIX>, + qr'(test|-o|-a)\s*[^\s]+\s+==\s' => q, + qr'\[\s+[^\]]+\s+==\s' => q, + qr'\s\|\&' => q, + qr'[^\\\$]\{([^\s\\\}]*?,)+[^\\\}\s]*\}' => q, + qr'\{\d+\.\.\d+(?:\.\.\d+)?\}' => + q, + qr'(?i)\{[a-z]\.\.[a-z](?:\.\.\d+)?\}' => q, + qr'(?:^|\s+)\w+\[\d+\]=' => q, + $LEADIN + . qr'read\s+(?:-[a-qs-zA-Z\d-]+)' => + q, + $LEADIN + . qr'read\s*(?:-\w+\s*)*(?:\".*?\"|[\'].*?[\'])?\s*(?:;|$)' => + q, + $LEADIN . qr'echo\s+(-n\s+)?-n?en?\s' => q, + $LEADIN . qr'exec\s+-[acl]' => q, + $LEADIN . qr'let\s' => q, + qr'(? q<'((' should be '$(('>, + qr'(?:^|\s+)(\[|test)\s+-a' => q, + qr'\&>' => qword 2\>&1>, + qr'(<\&|>\&)\s*((-|\d+)[^\s;|)}`&\\\\]|[^-\d\s]+(? + qword 2\>&1>, + qr'\[\[(?!:)' => + q, + qr'/dev/(tcp|udp)' => q, + $LEADIN . qr'builtin\s' => q, + $LEADIN . qr'caller\s' => q, + $LEADIN . qr'compgen\s' => q, + $LEADIN . qr'complete\s' => q, + $LEADIN . qr'declare\s' => q, + $LEADIN . qr'dirs(\s|\Z)' => q, + $LEADIN . qr'disown\s' => q, + $LEADIN . qr'enable\s' => q, + $LEADIN . qr'mapfile\s' => q, + $LEADIN . qr'readarray\s' => q, + $LEADIN . qr'shopt(\s|\Z)' => q, + $LEADIN . qr'suspend\s' => q, + $LEADIN . qr'time\s' => q