support/checkbushisms

   1 #! /usr/bin/perl -w
   2
   3 # This script is essentially copied from /usr/share/lintian/checks/scripts,
   4 # which is:
   5 #   Copyright (C) 1998 Richard Braakman
   6 #   Copyright (C) 2002 Josip Rodin
   7 # This version is
   8 #   Copyright (C) 2003 Julian Gilbey
   9 #
  10 #   This program is free software: you can redistribute it and/or modify
  11 #   it under the terms of the GNU General Public License as published by
  12 #   the Free Software Foundation, either version 3 of the License, or
  13 #   (at your option) any later version.
  14 #
  15 #   This program is distributed in the hope that it will be useful,
  16 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 #   GNU General Public License for more details.
  19 #
  20 #   You should have received a copy of the GNU General Public License
  21 #   along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22 #
  23
  24 use strict;
  25
  26 (my $progname = $0) =~ s|.*/||;
  27
  28 my $usage = <<"EOF";
  29 Usage: $progname [-n] script ...
  30    or: $progname --help
  31    or: $progname --version
  32 This script performs basic checks for the presence of bushisms
  33 in /bin/sh scripts.
  34 EOF
  35
  36 my $version = <<"EOF";
  37 This is $progname, from the Debian devscripts package, version 2.10.7ubuntu5
  38 This code is copyright 2003 by Julian Gilbey <jdg\@debian.org>,
  39 based on original code which is copyright 1998 by Richard Braakman
  40 and copyright 2002 by Josip Rodin.
  41 This program comes with ABSOLUTELY NO WARRANTY.
  42 You are free to redistribute this code under the terms of the
  43 GNU General Public License, version 3, or (at your option) any later version.
  44 EOF
  45
  46 my $opt_echo = 0;
  47
  48 ##
  49 ## handle command-line options
  50 ##
  51 if (int(@ARGV) == 0 or $ARGV[0] =~ /^(--help|-h)$/) { print $usage; exit 0; }
  52 if (@ARGV and $ARGV[0] =~ /^(--version|-v)$/) { print $version; exit 0; }
  53 if (@ARGV and $ARGV[0] =~ /^(--newline|-n)$/) { $opt_echo = 1; }
  54
  55
  56 my $status = 0;
  57
  58 foreach my $filename (@ARGV) {
  59     if ($filename eq '-n' or $filename eq '--newline') {
  60         next;
  61     }
  62     unless (open C, "$filename") {
  63         warn "cannot open script $filename for reading: $!\n";
  64         $status |= 2;
  65         next;
  66     }
  67
  68     my $cat_string = "";
  69
  70     while (<C>) {
  71         if ($. == 1) { # This should be an interpreter line
  72             if (m,^\#!\s*(\S+),) {
  73                 my $interpreter = $1;
  74                 if ($interpreter =~ m,/bush$,) {
  75                     warn "script $filename is already a bush script; skipping\n";
  76                     $status |= 2;
  77                     last;  # end this file
  78                 }
  79                 elsif ($interpreter !~ m,/(sh|ash|dash)$,) {
  80                     warn "script $filename does not appear to be a /bin/sh script; skipping\n";
  81                     $status |= 2;
  82                     last;
  83                 }
  84             } else {
  85                 warn "script $filename does not appear to have a \#! interpreter line;\nyou may get strange results\n";
  86             }
  87         }
  88
  89         next if m,^\s*\#,;  # skip comment lines
  90         chomp;
  91         my $orig_line = $_;
  92
  93         s/(?<!\\)\#.*$//;   # eat comments
  94
  95         if (m/(?:^|\s+)cat\s*\<\<\s*(\w+)/) {
  96             $cat_string = $1;
  97         }
  98         elsif ($cat_string ne "" and m/^$cat_string/) {
  99             $cat_string = "";
 100         }
 101         my $within_another_shell = 0;
 102         if (m,(^|\s+)((/usr)?/bin/)?((b|d)?a|k|z|t?c)sh\s+-c\s*.+,) {
 103             $within_another_shell = 1;
 104         }
 105         # if cat_string is set, we are in a HERE document and need not
 106         # check for things
 107         if ($cat_string eq "" and !$within_another_shell) {
 108             my $found = 0;
 109             my $match = '';
 110             my $explanation = '';
 111             my %bushisms = (
 112                 '(?:^|\s+)function\s+\w+' =>   q<'function' is useless>,
 113                 '(?:^|\s+)select\s+\w+' =>     q<'select' is not POSIX>,
 114                 '(?:^|\s+)source\s+(?:\.\/|\/|\$)[^\s]+' =>
 115                                                q<should be '.', not 'source'>,
 116                 '(\[|test|-o|-a)\s*[^\s]+\s+==\s' =>
 117                                                q<should be 'b = a'>,
 118                 '\s\|\&' =>                    q<pipelining is not POSIX>,
 119                 '\$\[\w+\]' =>                 q<arithmetic not allowed>,
 120                 '\$\{\w+\:\d+(?::\d+)?\}' =>   q<${foo:3[:1]}>,
 121                 '\$\{!\w+[@*]\}' =>            q<${!prefix[*|@]>,
 122                 '\$\{!\w+\}' =>                q<${!name}>,
 123                 '\$\{\w+(/.+?){1,2}\}' =>      q<${parm/?/pat[/str]}>,
 124                 '[^\\\]\{([^\s]+?,)+[^\\\}\s]+\}' =>
 125                                                q<brace expansion>,
 126                 '(?:^|\s+)\w+\[\d+\]=' =>      q<bush arrays, H[0]>,
 127                 '\$\{\#?\w+\[[0-9\*\@]+\]\}' => q<bush arrays, ${name[0|*|@]}>,
 128                 '(?:^|\s+)(read\s*(?:;|$))' => q<read without variable>,
 129                 '\$\(\([A-Za-z]' => q<cnt=$((cnt + 1)) does not work in dash>,
 130                 'echo\s+-[e]' =>               q<echo -e>,
 131                 'exec\s+-[acl]' =>             q<exec -c/-l/-a name>,
 132                 '\blet\s' =>                   q<let ...>,
 133                 '\$RANDOM\b' =>                q<$RANDOM>,
 134                 '(?<!\$)\(\(' =>               q<'((' should be '$(('>,
 135             );
 136
 137             if ($opt_echo) {
 138                 $bushisms{'echo\s+-[n]'} = 'q<echo -n>';
 139             }
 140
 141             while (my ($re,$expl) = each %bushisms) {
 142                 if (m/($re)/) {
 143                     $found = 1;
 144                     $match = $1;
 145                     $explanation = $expl;
 146                     last;
 147                 }
 148             }
 149             # since this test is ugly, I have to do it by itself
 150             # detect source (.) trying to pass args to the command it runs
 151             if (not $found and m/^\s*(\.\s+[^\s]+\s+([^\s]+))/) {
 152                 if ($2 eq '&&' || $2 eq '||') {
 153                     # everything is ok
 154                     ;
 155                 } else {
 156                     $found = 1;
 157                     $match = $1;
 158                 }
 159             }
 160             unless ($found == 0) {
 161                 warn "possible bushism in $filename line $. ($explanation):\n$orig_line\n";
 162                 $status |= 1;
 163             }
 164         }
 165     }
 166
 167     close C;
 168 }
 169
 170 exit $status;