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/Makefile.am | 14 + lint/checkbashisms.pl | 814 ----------------------------------------------- lint/checkbashisms.pl.in | 814 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 828 insertions(+), 814 deletions(-) delete mode 100755 lint/checkbashisms.pl create mode 100755 lint/checkbashisms.pl.in (limited to 'lint') diff --git a/lint/Makefile.am b/lint/Makefile.am index 59d4b6073..0de8da54a 100644 --- a/lint/Makefile.am +++ b/lint/Makefile.am @@ -1,5 +1,19 @@ all: check-linters +do_subst = $(SED) -e 's,[@]PERL[@],$(PERL),g' + +SUFFIXES = pl.in .pl + +checkbashisms.pl: checkbashisms.pl.in Makefile + $(do_subst) < $(srcdir)/checkbashisms.pl.in > checkbashisms.pl + chmod +x checkbashisms.pl + +CLEANFILES= \ + checkbashisms.pl + +noinst_SCRIPTS = \ + $(CLEANFILES) + # Check for bashisms in shell scripts # Very verbose, need to exclude more files. check-bashism: diff --git a/lint/checkbashisms.pl b/lint/checkbashisms.pl deleted file mode 100755 index b2a3c9aa1..000000000 --- a/lint/checkbashisms.pl +++ /dev/null @@ -1,814 +0,0 @@ -#!/usr/bin/env 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