| #! /usr/bin/perl -w |
| |
| # 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 3 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 <http://www.gnu.org/licenses/>. |
| # |
| |
| use strict; |
| |
| (my $progname = $0) =~ s|.*/||; |
| |
| my $usage = <<"EOF"; |
| Usage: $progname [-n] script ... |
| or: $progname --help |
| or: $progname --version |
| This script performs basic checks for the presence of bashisms |
| in /bin/sh scripts. |
| EOF |
| |
| my $version = <<"EOF"; |
| This is $progname, from the Debian devscripts package, version 2.10.7ubuntu5 |
| This code is copyright 2003 by Julian Gilbey <jdg\@debian.org>, |
| 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 3, or (at your option) any later version. |
| EOF |
| |
| my $opt_echo = 0; |
| |
| ## |
| ## handle command-line options |
| ## |
| if (int(@ARGV) == 0 or $ARGV[0] =~ /^(--help|-h)$/) { print $usage; exit 0; } |
| if (@ARGV and $ARGV[0] =~ /^(--version|-v)$/) { print $version; exit 0; } |
| if (@ARGV and $ARGV[0] =~ /^(--newline|-n)$/) { $opt_echo = 1; } |
| |
| |
| my $status = 0; |
| |
| foreach my $filename (@ARGV) { |
| if ($filename eq '-n' or $filename eq '--newline') { |
| next; |
| } |
| unless (open C, "$filename") { |
| warn "cannot open script $filename for reading: $!\n"; |
| $status |= 2; |
| next; |
| } |
| |
| my $cat_string = ""; |
| |
| while (<C>) { |
| if ($. == 1) { # This should be an interpreter line |
| if (m,^\#!\s*(\S+),) { |
| my $interpreter = $1; |
| if ($interpreter =~ m,/bash$,) { |
| warn "script $filename is already a bash script; skipping\n"; |
| $status |= 2; |
| last; # end this file |
| } |
| elsif ($interpreter !~ m,/(sh|ash|dash)$,) { |
| warn "script $filename does not appear to be a /bin/sh script; skipping\n"; |
| $status |= 2; |
| last; |
| } |
| } else { |
| warn "script $filename does not appear to have a \#! interpreter line;\nyou may get strange results\n"; |
| } |
| } |
| |
| next if m,^\s*\#,; # skip comment lines |
| chomp; |
| my $orig_line = $_; |
| |
| s/(?<!\\)\#.*$//; # eat comments |
| |
| if (m/(?:^|\s+)cat\s*\<\<\s*(\w+)/) { |
| $cat_string = $1; |
| } |
| elsif ($cat_string ne "" and m/^$cat_string/) { |
| $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 !$within_another_shell) { |
| my $found = 0; |
| my $match = ''; |
| my $explanation = ''; |
| my %bashisms = ( |
| '(?:^|\s+)function\s+\w+' => q<'function' is useless>, |
| '(?:^|\s+)select\s+\w+' => q<'select' is not POSIX>, |
| '(?:^|\s+)source\s+(?:\.\/|\/|\$)[^\s]+' => |
| q<should be '.', not 'source'>, |
| '(\[|test|-o|-a)\s*[^\s]+\s+==\s' => |
| q<should be 'b = a'>, |
| '\s\|\&' => q<pipelining is not POSIX>, |
| '\$\[\w+\]' => q<arithmetic not allowed>, |
| '\$\{\w+\:\d+(?::\d+)?\}' => q<${foo:3[:1]}>, |
| '\$\{!\w+[@*]\}' => q<${!prefix[*|@]>, |
| '\$\{!\w+\}' => q<${!name}>, |
| '\$\{\w+(/.+?){1,2}\}' => q<${parm/?/pat[/str]}>, |
| '[^\\\]\{([^\s]+?,)+[^\\\}\s]+\}' => |
| q<brace expansion>, |
| '(?:^|\s+)\w+\[\d+\]=' => q<bash arrays, H[0]>, |
| '\$\{\#?\w+\[[0-9\*\@]+\]\}' => q<bash arrays, ${name[0|*|@]}>, |
| '(?:^|\s+)(read\s*(?:;|$))' => q<read without variable>, |
| '\$\(\([A-Za-z]' => q<cnt=$((cnt + 1)) does not work in dash>, |
| 'echo\s+-[e]' => q<echo -e>, |
| 'exec\s+-[acl]' => q<exec -c/-l/-a name>, |
| '\blet\s' => q<let ...>, |
| '\$RANDOM\b' => q<$RANDOM>, |
| '(?<!\$)\(\(' => q<'((' should be '$(('>, |
| ); |
| |
| if ($opt_echo) { |
| $bashisms{'echo\s+-[n]'} = 'q<echo -n>'; |
| } |
| |
| while (my ($re,$expl) = each %bashisms) { |
| if (m/($re)/) { |
| $found = 1; |
| $match = $1; |
| $explanation = $expl; |
| last; |
| } |
| } |
| # since this test is ugly, I have to do it by itself |
| # detect source (.) trying to pass args to the command it runs |
| if (not $found and m/^\s*(\.\s+[^\s]+\s+([^\s]+))/) { |
| if ($2 eq '&&' || $2 eq '||') { |
| # everything is ok |
| ; |
| } else { |
| $found = 1; |
| $match = $1; |
| } |
| } |
| unless ($found == 0) { |
| warn "possible bashism in $filename line $. ($explanation):\n$orig_line\n"; |
| $status |= 1; |
| } |
| } |
| } |
| |
| close C; |
| } |
| |
| exit $status; |