• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1#!/usr/bin/perl
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 2 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 <https://www.gnu.org/licenses/>.
22
23use strict;
24use warnings;
25use Getopt::Long qw(:config bundling permute no_getopt_compat);
26use File::Temp qw/tempfile/;
27
28sub init_hashes;
29
30(my $progname = $0) =~ s|.*/||;
31
32my $usage = <<"EOF";
33Usage: $progname [-n] [-f] [-x] [-e] script ...
34   or: $progname --help
35   or: $progname --version
36This script performs basic checks for the presence of bashisms
37in /bin/sh scripts and the lack of bashisms in /bin/bash ones.
38EOF
39
40my $version = <<"EOF";
41This is $progname, from the Debian devscripts package, version 2.20.5
42This code is copyright 2003 by Julian Gilbey <jdg\@debian.org>,
43based on original code which is copyright 1998 by Richard Braakman
44and copyright 2002 by Josip Rodin.
45This program comes with ABSOLUTELY NO WARRANTY.
46You are free to redistribute this code under the terms of the
47GNU General Public License, version 2, or (at your option) any later version.
48EOF
49
50my ($opt_echo, $opt_force, $opt_extra, $opt_posix, $opt_early_fail);
51my ($opt_help, $opt_version);
52my @filenames;
53
54# Detect if STDIN is a pipe
55if (scalar(@ARGV) == 0 && (-p STDIN or -f STDIN)) {
56    push(@ARGV, '-');
57}
58
59##
60## handle command-line options
61##
62$opt_help = 1 if int(@ARGV) == 0;
63
64GetOptions(
65    "help|h"       => \$opt_help,
66    "version|v"    => \$opt_version,
67    "newline|n"    => \$opt_echo,
68    "force|f"      => \$opt_force,
69    "extra|x"      => \$opt_extra,
70    "posix|p"      => \$opt_posix,
71    "early-fail|e" => \$opt_early_fail,
72  )
73  or die
74"Usage: $progname [options] filelist\nRun $progname --help for more details\n";
75
76if ($opt_help)    { print $usage;   exit 0; }
77if ($opt_version) { print $version; exit 0; }
78
79$opt_echo = 1 if $opt_posix;
80
81my $mode     = 0;
82my $issues   = 0;
83my $status   = 0;
84my $makefile = 0;
85my (%bashisms, %string_bashisms, %singlequote_bashisms);
86
87my $LEADIN
88  = qr'(?:(?:^|[`&;(|{])\s*|(?:(?:if|elif|while)(?:\s+!)?|then|do|shell)\s+)';
89init_hashes;
90
91my @bashisms_keys             = sort keys %bashisms;
92my @string_bashisms_keys      = sort keys %string_bashisms;
93my @singlequote_bashisms_keys = sort keys %singlequote_bashisms;
94
95foreach my $filename (@ARGV) {
96    my $check_lines_count = -1;
97
98    my $display_filename = $filename;
99
100    if ($filename eq '-') {
101        my $tmp_fh;
102        ($tmp_fh, $filename)
103          = tempfile("chkbashisms_tmp.XXXX", TMPDIR => 1, UNLINK => 1);
104        while (my $line = <STDIN>) {
105            print $tmp_fh $line;
106        }
107        close($tmp_fh);
108        $display_filename = "(stdin)";
109    }
110
111    if (!$opt_force) {
112        $check_lines_count = script_is_evil_and_wrong($filename);
113    }
114
115    if ($check_lines_count == 0 or $check_lines_count == 1) {
116        warn
117"script $display_filename does not appear to be a /bin/sh script; skipping\n";
118        next;
119    }
120
121    if ($check_lines_count != -1) {
122        warn
123"script $display_filename appears to be a shell wrapper; only checking the first "
124          . "$check_lines_count lines\n";
125    }
126
127    unless (open C, '<', $filename) {
128        warn "cannot open script $display_filename for reading: $!\n";
129        $status |= 2;
130        next;
131    }
132
133    $issues = 0;
134    $mode   = 0;
135    my $cat_string         = "";
136    my $cat_indented       = 0;
137    my $quote_string       = "";
138    my $last_continued     = 0;
139    my $continued          = 0;
140    my $found_rules        = 0;
141    my $buffered_orig_line = "";
142    my $buffered_line      = "";
143    my %start_lines;
144
145    while (<C>) {
146        next unless ($check_lines_count == -1 or $. <= $check_lines_count);
147
148        if ($. == 1) {    # This should be an interpreter line
149            if (m,^\#!\s*(?:\S+/env\s+)?(\S+),) {
150                my $interpreter = $1;
151
152                if ($interpreter =~ m,(?:^|/)make$,) {
153                    init_hashes if !$makefile++;
154                    $makefile = 1;
155                } else {
156                    init_hashes if $makefile--;
157                    $makefile = 0;
158                }
159                next if $opt_force;
160
161                if ($interpreter =~ m,(?:^|/)bash$,) {
162                    $mode = 1;
163                } elsif ($interpreter !~ m,(?:^|/)(sh|dash|posh)$,) {
164### ksh/zsh?
165                    warn
166"script $display_filename does not appear to be a /bin/sh script; skipping\n";
167                    $status |= 2;
168                    last;
169                }
170            } else {
171                warn
172"script $display_filename does not appear to have a \#! interpreter line;\nyou may get strange results\n";
173            }
174        }
175
176        chomp;
177        my $orig_line = $_;
178
179        # We want to remove end-of-line comments, so need to skip
180        # comments that appear inside balanced pairs
181        # of single or double quotes
182
183        # Remove comments in the "quoted" part of a line that starts
184        # in a quoted block? The problem is that we have no idea
185        # whether the program interpreting the block treats the
186        # quote character as part of the comment or as a quote
187        # terminator. We err on the side of caution and assume it
188        # will be treated as part of the comment.
189        # s/^(?:.*?[^\\])?$quote_string(.*)$/$1/ if $quote_string ne "";
190
191        # skip comment lines
192        if (   m,^\s*\#,
193            && $quote_string eq ''
194            && $buffered_line eq ''
195            && $cat_string eq '') {
196            next;
197        }
198
199        # Remove quoted strings so we can more easily ignore comments
200        # inside them
201        s/(^|[^\\](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g;
202        s/(^|[^\\](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g;
203
204        # If inside a quoted string, remove everything before the quote
205        s/^.+?\'//
206          if ($quote_string eq "'");
207        s/^.+?[^\\]\"//
208          if ($quote_string eq '"');
209
210        # If the remaining string contains what looks like a comment,
211        # eat it. In either case, swap the unmodified script line
212        # back in for processing.
213        if (m/(?:^|[^[\\])[\s\&;\(\)](\#.*$)/) {
214            $_ = $orig_line;
215            s/\Q$1\E//;    # eat comments
216        } else {
217            $_ = $orig_line;
218        }
219
220        # Handle line continuation
221        if (!$makefile && $cat_string eq '' && m/\\$/) {
222            chop;
223            $buffered_line      .= $_;
224            $buffered_orig_line .= $orig_line . "\n";
225            next;
226        }
227
228        if ($buffered_line ne '') {
229            $_                  = $buffered_line . $_;
230            $orig_line          = $buffered_orig_line . $orig_line;
231            $buffered_line      = '';
232            $buffered_orig_line = '';
233        }
234
235        if ($makefile) {
236            $last_continued = $continued;
237            if (/[^\\]\\$/) {
238                $continued = 1;
239            } else {
240                $continued = 0;
241            }
242
243            # Don't match lines that look like a rule if we're in a
244            # continuation line before the start of the rules
245            if (/^[\w%-]+:+\s.*?;?(.*)$/
246                and !($last_continued and !$found_rules)) {
247                $found_rules = 1;
248                $_           = $1 if $1;
249            }
250
251            last
252              if m%^\s*(override\s|export\s)?\s*SHELL\s*:?=\s*(/bin/)?bash\s*%;
253
254            # Remove "simple" target names
255            s/^[\w%.-]+(?:\s+[\w%.-]+)*::?//;
256            s/^\t//;
257            s/(?<!\$)\$\((\w+)\)/\${$1}/g;
258            s/(\$){2}/$1/g;
259            s/^[\s\t]*[@-]{1,2}//;
260        }
261
262        if (
263            $cat_string ne ""
264            && (m/^\Q$cat_string\E$/
265                || ($cat_indented && m/^\t*\Q$cat_string\E$/))
266        ) {
267            $cat_string = "";
268            next;
269        }
270        my $within_another_shell = 0;
271        if (m,(^|\s+)((/usr)?/bin/)?((b|d)?a|k|z|t?c)sh\s+-c\s*.+,) {
272            $within_another_shell = 1;
273        }
274        # if cat_string is set, we are in a HERE document and need not
275        # check for things
276        if ($cat_string eq "" and !$within_another_shell) {
277            my $found       = 0;
278            my $match       = '';
279            my $explanation = '';
280            my $line        = $_;
281
282            # Remove "" / '' as they clearly aren't quoted strings
283            # and not considering them makes the matching easier
284            $line =~ s/(^|[^\\])(\'\')+/$1/g;
285            $line =~ s/(^|[^\\])(\"\")+/$1/g;
286
287            if ($quote_string ne "") {
288                my $otherquote = ($quote_string eq "\"" ? "\'" : "\"");
289                # Inside a quoted block
290                if ($line =~ /(?:^|^.*?[^\\])$quote_string(.*)$/) {
291                    my $rest     = $1;
292                    my $templine = $line;
293
294                    # Remove quoted strings delimited with $otherquote
295                    $templine
296                      =~ s/(^|[^\\])$otherquote[^$quote_string]*?[^\\]$otherquote/$1/g;
297                    # Remove quotes that are themselves quoted
298                    # "a'b"
299                    $templine
300                      =~ s/(^|[^\\])$otherquote.*?$quote_string.*?[^\\]$otherquote/$1/g;
301                    # "\""
302                    $templine
303                      =~ s/(^|[^\\])$quote_string\\$quote_string$quote_string/$1/g;
304
305                    # After all that, were there still any quotes left?
306                    my $count = () = $templine =~ /(^|[^\\])$quote_string/g;
307                    next if $count == 0;
308
309                    $count = () = $rest =~ /(^|[^\\])$quote_string/g;
310                    if ($count % 2 == 0) {
311                        # Quoted block ends on this line
312                        # Ignore everything before the closing quote
313                        $line         = $rest || '';
314                        $quote_string = "";
315                    } else {
316                        next;
317                    }
318                } else {
319                    # Still inside the quoted block, skip this line
320                    next;
321                }
322            }
323
324            # Check even if we removed the end of a quoted block
325            # in the previous check, as a single line can end one
326            # block and begin another
327            if ($quote_string eq "") {
328                # Possible start of a quoted block
329                for my $quote ("\"", "\'") {
330                    my $templine   = $line;
331                    my $otherquote = ($quote eq "\"" ? "\'" : "\"");
332
333                    # Remove balanced quotes and their content
334                    while (1) {
335                        my ($length_single, $length_double) = (0, 0);
336
337                        # Determine which one would match first:
338                        if ($templine
339                            =~ m/(^.+?(?:^|[^\\\"](?:\\\\)*)\')[^\']*\'/) {
340                            $length_single = length($1);
341                        }
342                        if ($templine
343                            =~ m/(^.*?(?:^|[^\\\'](?:\\\\)*)\")(?:\\.|[^\\\"])+\"/
344                        ) {
345                            $length_double = length($1);
346                        }
347
348                        # Now simplify accordingly (shorter is preferred):
349                        if (
350                            $length_single != 0
351                            && (   $length_single < $length_double
352                                || $length_double == 0)
353                        ) {
354                            $templine =~ s/(^|[^\\\"](?:\\\\)*)\'[^\']*\'/$1/;
355                        } elsif ($length_double != 0) {
356                            $templine
357                              =~ s/(^|[^\\\'](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1/;
358                        } else {
359                            last;
360                        }
361                    }
362
363                    # Don't flag quotes that are themselves quoted
364                    # "a'b"
365                    $templine =~ s/$otherquote.*?$quote.*?$otherquote//g;
366                    # "\""
367                    $templine =~ s/(^|[^\\])$quote\\$quote$quote/$1/g;
368                    # \' or \"
369                    $templine =~ s/\\[\'\"]//g;
370                    my $count = () = $templine =~ /(^|(?!\\))$quote/g;
371
372                    # If there's an odd number of non-escaped
373                    # quotes in the line it's almost certainly the
374                    # start of a quoted block.
375                    if ($count % 2 == 1) {
376                        $quote_string = $quote;
377                        $start_lines{'quote_string'} = $.;
378                        $line =~ s/^(.*)$quote.*$/$1/;
379                        last;
380                    }
381                }
382            }
383
384            # since this test is ugly, I have to do it by itself
385            # detect source (.) trying to pass args to the command it runs
386            # The first expression weeds out '. "foo bar"'
387            if (    not $found
388                and not
389m/$LEADIN\.\s+(\"[^\"]+\"|\'[^\']+\'|\$\([^)]+\)+(?:\/[^\s;]+)?)\s*(\&|\||\d?>|<|;|\Z)/o
390                and m/$LEADIN(\.\s+[^\s;\`:]+\s+([^\s;]+))/o) {
391                if ($2 =~ /^(\&|\||\d?>|<)/) {
392                    # everything is ok
393                    ;
394                } else {
395                    $found       = 1;
396                    $match       = $1;
397                    $explanation = "sourced script with arguments";
398                    output_explanation($display_filename, $orig_line,
399                        $explanation);
400                }
401            }
402
403            # Remove "quoted quotes". They're likely to be inside
404            # another pair of quotes; we're not interested in
405            # them for their own sake and removing them makes finding
406            # the limits of the outer pair far easier.
407            $line =~ s/(^|[^\\\'\"])\"\'\"/$1/g;
408            $line =~ s/(^|[^\\\'\"])\'\"\'/$1/g;
409
410            foreach my $re (@singlequote_bashisms_keys) {
411                my $expl = $singlequote_bashisms{$re};
412                if ($line =~ m/($re)/) {
413                    $found       = 1;
414                    $match       = $1;
415                    $explanation = $expl;
416                    output_explanation($display_filename, $orig_line,
417                        $explanation);
418                }
419            }
420
421            my $re = '(?<![\$\\\])\$\'[^\']+\'';
422            if ($line =~ m/(.*)($re)/o) {
423                my $count = () = $1 =~ /(^|[^\\])\'/g;
424                if ($count % 2 == 0) {
425                    output_explanation($display_filename, $orig_line,
426                        q<$'...' should be "$(printf '...')">);
427                }
428            }
429
430            # $cat_line contains the version of the line we'll check
431            # for heredoc delimiters later. Initially, remove any
432            # spaces between << and the delimiter to make the following
433            # updates to $cat_line easier. However, don't remove the
434            # spaces if the delimiter starts with a -, as that changes
435            # how the delimiter is searched.
436            my $cat_line = $line;
437            $cat_line =~ s/(<\<-?)\s+(?!-)/$1/g;
438
439            # Ignore anything inside single quotes; it could be an
440            # argument to grep or the like.
441            $line =~ s/(^|[^\\\"](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g;
442
443            # As above, with the exception that we don't remove the string
444            # if the quote is immediately preceded by a < or a -, so we
445            # can match "foo <<-?'xyz'" as a heredoc later
446            # The check is a little more greedy than we'd like, but the
447            # heredoc test itself will weed out any false positives
448            $cat_line =~ s/(^|[^<\\\"-](?:\\\\)*)\'(?:\\.|[^\\\'])+\'/$1''/g;
449
450            $re = '(?<![\$\\\])\$\"[^\"]+\"';
451            if ($line =~ m/(.*)($re)/o) {
452                my $count = () = $1 =~ /(^|[^\\])\"/g;
453                if ($count % 2 == 0) {
454                    output_explanation($display_filename, $orig_line,
455                        q<$"foo" should be eval_gettext "foo">);
456                }
457            }
458
459            foreach my $re (@string_bashisms_keys) {
460                my $expl = $string_bashisms{$re};
461                if ($line =~ m/($re)/) {
462                    $found       = 1;
463                    $match       = $1;
464                    $explanation = $expl;
465                    output_explanation($display_filename, $orig_line,
466                        $explanation);
467                }
468            }
469
470            # We've checked for all the things we still want to notice in
471            # double-quoted strings, so now remove those strings as well.
472            $line     =~ s/(^|[^\\\'](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g;
473            $cat_line =~ s/(^|[^<\\\'-](?:\\\\)*)\"(?:\\.|[^\\\"])+\"/$1""/g;
474            foreach my $re (@bashisms_keys) {
475                my $expl = $bashisms{$re};
476                if ($line =~ m/($re)/) {
477                    $found       = 1;
478                    $match       = $1;
479                    $explanation = $expl;
480                    output_explanation($display_filename, $orig_line,
481                        $explanation);
482                }
483            }
484            # This check requires the value to be compared, which could
485            # be done in the regex itself but requires "use re 'eval'".
486            # So it's better done in its own
487            if ($line =~ m/$LEADIN((?:exit|return)\s+(\d{3,}))/o && $2 > 255) {
488                $explanation = 'exit|return status code greater than 255';
489                output_explanation($display_filename, $orig_line,
490                    $explanation);
491            }
492
493            # Only look for the beginning of a heredoc here, after we've
494            # stripped out quoted material, to avoid false positives.
495            if ($cat_line
496                =~ m/(?:^|[^<])\<\<(\-?)\s*(?:(?!<|'|")((?:[^\s;>|]+(?:(?<=\\)[\s;>|])?)+)|[\'\"](.*?)[\'\"])/
497            ) {
498                $cat_indented = ($1 && $1 eq '-') ? 1 : 0;
499                my $quoted = defined($3);
500                $cat_string = $quoted ? $3 : $2;
501                unless ($quoted) {
502                    # Now strip backslashes. Keep the position of the
503                    # last match in a variable, as s/// resets it back
504                    # to undef, but we don't want that.
505                    my $pos = 0;
506                    pos($cat_string) = $pos;
507                    while ($cat_string =~ s/\G(.*?)\\/$1/) {
508                        # position += length of match + the character
509                        # that followed the backslash:
510                        $pos += length($1) + 1;
511                        pos($cat_string) = $pos;
512                    }
513                }
514                $start_lines{'cat_string'} = $.;
515            }
516        }
517    }
518
519    warn
520"error: $display_filename:  Unterminated heredoc found, EOF reached. Wanted: <$cat_string>, opened in line $start_lines{'cat_string'}\n"
521      if ($cat_string ne '');
522    warn
523"error: $display_filename: Unterminated quoted string found, EOF reached. Wanted: <$quote_string>, opened in line $start_lines{'quote_string'}\n"
524      if ($quote_string ne '');
525    warn "error: $display_filename: EOF reached while on line continuation.\n"
526      if ($buffered_line ne '');
527
528    close C;
529
530    if ($mode && !$issues) {
531        warn "could not find any possible bashisms in bash script $filename\n";
532        $status |= 4;
533    }
534}
535
536exit $status;
537
538sub output_explanation {
539    my ($filename, $line, $explanation) = @_;
540
541    if ($mode) {
542        # When examining a bash script, just flag that there are indeed
543        # bashisms present
544        $issues = 1;
545    } else {
546        warn "possible bashism in $filename line $. ($explanation):\n$line\n";
547        if ($opt_early_fail) {
548            exit 1;
549        }
550        $status |= 1;
551    }
552}
553
554# Returns non-zero if the given file is not actually a shell script,
555# just looks like one.
556sub script_is_evil_and_wrong {
557    my ($filename) = @_;
558    my $ret = -1;
559    # lintian's version of this function aborts if the file
560    # can't be opened, but we simply return as the next
561    # test in the calling code handles reporting the error
562    # itself
563    open(IN, '<', $filename) or return $ret;
564    my $i            = 0;
565    my $var          = "0";
566    my $backgrounded = 0;
567    local $_;
568    while (<IN>) {
569        chomp;
570        next if /^#/o;
571        next if /^$/o;
572        last if (++$i > 55);
573        if (
574            m~
575	    # the exec should either be "eval"ed or a new statement
576	    (^\s*|\beval\s*[\'\"]|(;|&&|\b(then|else))\s*)
577
578	    # eat anything between the exec and $0
579	    exec\s*.+\s*
580
581	    # optionally quoted executable name (via $0)
582	    .?\$$var.?\s*
583
584	    # optional "end of options" indicator
585	    (--\s*)?
586
587	    # Match expressions of the form '${1+$@}', '${1:+"$@"',
588	    # '"${1+$@', "$@", etc where the quotes (before the dollar
589	    # sign(s)) are optional and the second (or only if the $1
590	    # clause is omitted) parameter may be $@ or $*.
591	    #
592	    # Finally the whole subexpression may be omitted for scripts
593	    # which do not pass on their parameters (i.e. after re-execing
594	    # they take their parameters (and potentially data) from stdin
595	    .?(\$\{1:?\+.?)?(\$(\@|\*))?~x
596        ) {
597            $ret = $. - 1;
598            last;
599        } elsif (/^\s*(\w+)=\$0;/) {
600            $var = $1;
601        } elsif (
602            m~
603	    # Match scripts which use "foo $0 $@ &\nexec true\n"
604	    # Program name
605	    \S+\s+
606
607	    # As above
608	    .?\$$var.?\s*
609	    (--\s*)?
610	    .?(\$\{1:?\+.?)?(\$(\@|\*))?.?\s*\&~x
611        ) {
612
613            $backgrounded = 1;
614        } elsif (
615            $backgrounded
616            and m~
617	    # the exec should either be "eval"ed or a new statement
618	    (^\s*|\beval\s*[\'\"]|(;|&&|\b(then|else))\s*)
619	    exec\s+true(\s|\Z)~x
620        ) {
621
622            $ret = $. - 1;
623            last;
624        } elsif (m~\@DPATCH\@~) {
625            $ret = $. - 1;
626            last;
627        }
628
629    }
630    close IN;
631    return $ret;
632}
633
634sub init_hashes {
635
636    %bashisms = (
637        qr'(?:^|\s+)function [^<>\(\)\[\]\{\};|\s]+(\s|\(|\Z)' =>
638          q<'function' is useless>,
639        $LEADIN . qr'select\s+\w+'               => q<'select' is not POSIX>,
640        qr'(test|-o|-a)\s*[^\s]+\s+==\s'         => q<should be 'b = a'>,
641        qr'\[\s+[^\]]+\s+==\s'                   => q<should be 'b = a'>,
642        qr'\s\|\&'                               => q<pipelining is not POSIX>,
643        qr'[^\\\$]\{([^\s\\\}]*?,)+[^\\\}\s]*\}' => q<brace expansion>,
644        qr'\{\d+\.\.\d+(?:\.\.\d+)?\}' =>
645          q<brace expansion, {a..b[..c]}should be $(seq a [c] b)>,
646        qr'(?i)\{[a-z]\.\.[a-z](?:\.\.\d+)?\}' => q<brace expansion>,
647        qr'(?:^|\s+)\w+\[\d+\]='               => q<bash arrays, H[0]>,
648        $LEADIN
649          . qr'read\s+(?:-[a-qs-zA-Z\d-]+)' =>
650          q<read with option other than -r>,
651        $LEADIN
652          . qr'read\s*(?:-\w+\s*)*(?:\".*?\"|[\'].*?[\'])?\s*(?:;|$)' =>
653          q<read without variable>,
654        $LEADIN . qr'echo\s+(-n\s+)?-n?en?\s' => q<echo -e>,
655        $LEADIN . qr'exec\s+-[acl]'           => q<exec -c/-l/-a name>,
656        $LEADIN . qr'let\s'                   => q<let ...>,
657        qr'(?<![\$\(])\(\(.*\)\)'             => q<'((' should be '$(('>,
658        qr'(?:^|\s+)(\[|test)\s+-a' => q<test with unary -a (should be -e)>,
659        qr'\&>'                     => q<should be \>word 2\>&1>,
660        qr'(<\&|>\&)\s*((-|\d+)[^\s;|)}`&\\\\]|[^-\d\s]+(?<!\$)(?!\d))' =>
661          q<should be \>word 2\>&1>,
662        qr'\[\[(?!:)' =>
663          q<alternative test command ([[ foo ]] should be [ foo ])>,
664        qr'/dev/(tcp|udp)'               => q</dev/(tcp|udp)>,
665        $LEADIN . qr'builtin\s'          => q<builtin>,
666        $LEADIN . qr'caller\s'           => q<caller>,
667        $LEADIN . qr'compgen\s'          => q<compgen>,
668        $LEADIN . qr'complete\s'         => q<complete>,
669        $LEADIN . qr'declare\s'          => q<declare>,
670        $LEADIN . qr'dirs(\s|\Z)'        => q<dirs>,
671        $LEADIN . qr'disown\s'           => q<disown>,
672        $LEADIN . qr'enable\s'           => q<enable>,
673        $LEADIN . qr'mapfile\s'          => q<mapfile>,
674        $LEADIN . qr'readarray\s'        => q<readarray>,
675        $LEADIN . qr'shopt(\s|\Z)'       => q<shopt>,
676        $LEADIN . qr'suspend\s'          => q<suspend>,
677        $LEADIN . qr'time\s'             => q<time>,
678        $LEADIN . qr'type\s'             => q<type>,
679        $LEADIN . qr'typeset\s'          => q<typeset>,
680        $LEADIN . qr'ulimit(\s|\Z)'      => q<ulimit>,
681        $LEADIN . qr'set\s+-[BHT]+'      => q<set -[BHT]>,
682        $LEADIN . qr'alias\s+-p'         => q<alias -p>,
683        $LEADIN . qr'unalias\s+-a'       => q<unalias -a>,
684        $LEADIN . qr'local\s+-[a-zA-Z]+' => q<local -opt>,
685        # function '=' is special-cased due to bash arrays (think of "foo=()")
686        qr'(?:^|\s)\s*=\s*\(\s*\)\s*([\{|\(]|\Z)' =>
687          q<function names should only contain [a-z0-9_]>,
688qr'(?:^|\s)(?<func>function\s)?\s*(?:[^<>\(\)\[\]\{\};|\s]*[^<>\(\)\[\]\{\};|\s\w][^<>\(\)\[\]\{\};|\s]*)(?(<func>)(?=)|(?<!=))\s*(?(<func>)(?:\(\s*\))?|\(\s*\))\s*([\{|\(]|\Z)'
689          => q<function names should only contain [a-z0-9_]>,
690        $LEADIN . qr'(push|pop)d(\s|\Z)' => q<(push|pop)d>,
691        $LEADIN . qr'export\s+-[^p]'   => q<export only takes -p as an option>,
692        qr'(?:^|\s+)[<>]\(.*?\)'       => q<\<() process substitution>,
693        $LEADIN . qr'readonly\s+-[af]' => q<readonly -[af]>,
694        $LEADIN . qr'(sh|\$\{?SHELL\}?) -[rD]' => q<sh -[rD]>,
695        $LEADIN . qr'(sh|\$\{?SHELL\}?) --\w+' => q<sh --long-option>,
696        $LEADIN . qr'(sh|\$\{?SHELL\}?) [-+]O' => q<sh [-+]O>,
697        qr'\[\^[^]]+\]'                        => q<[^] should be [!]>,
698        $LEADIN
699          . qr'printf\s+-v' =>
700          q<'printf -v var ...' should be var='$(printf ...)'>,
701        $LEADIN . qr'coproc\s' => q<coproc>,
702        qr';;?&'               => q<;;& and ;& special case operators>,
703        $LEADIN . qr'jobs\s'   => q<jobs>,
704 #	$LEADIN . qr'jobs\s+-[^lp]\s' =>  q<'jobs' with option other than -l or -p>,
705        $LEADIN
706          . qr'command\s+(?:-[pvV]+\s+)*-(?:[pvV])*[^pvV\s]' =>
707          q<'command' with option other than -p, -v or -V>,
708        $LEADIN
709          . qr'setvar\s' =>
710          q<setvar 'foo' 'bar' should be eval 'foo="'"$bar"'"'>,
711        $LEADIN
712          . qr'trap\s+["\']?.*["\']?\s+.*(?:ERR|DEBUG|RETURN)' =>
713          q<trap with ERR|DEBUG|RETURN>,
714        $LEADIN
715          . qr'(?:exit|return)\s+-\d' =>
716          q<exit|return with negative status code>,
717        $LEADIN
718          . qr'(?:exit|return)\s+--' =>
719          q<'exit --' should be 'exit' (idem for return)>,
720        $LEADIN . qr'hash(\s|\Z)' => q<hash>,
721        qr'(?:[:=\s])~(?:[+-]|[+-]?\d+)(?:[/\s]|\Z)' =>
722          q<non-standard tilde expansion>,
723    );
724
725    %string_bashisms = (
726        qr'\$\[[^][]+\]' => q<'$[' should be '$(('>,
727        qr'\$\{(?:\w+|@|\*)\:(?:\d+|\$\{?\w+\}?)+(?::(?:\d+|\$\{?\w+\}?)+)?\}'
728          => q<${foo:3[:1]}>,
729        qr'\$\{!\w+[\@*]\}' => q<${!prefix[*|@]>,
730        qr'\$\{!\w+\}'      => q<${!name}>,
731        qr'\$\{(?:\w+|@|\*)([,^]{1,2}.*?)\}' =>
732          q<${parm,[,][pat]} or ${parm^[^][pat]}>,
733        qr'\$\{[@*]([#%]{1,2}.*?)\}' => q<${[@|*]#[#]pat} or ${[@|*]%[%]pat}>,
734        qr'\$\{#[@*]\}'              => q<${#@} or ${#*}>,
735        qr'\$\{(?:\w+|@|\*)(/.+?){1,2}\}' => q<${parm/?/pat[/str]}>,
736        qr'\$\{\#?\w+\[.+\](?:[/,:#%^].+?)?\}' =>
737          q<bash arrays, ${name[0|*|@]}>,
738        qr'\$\{?RANDOM\}?\b'          => q<$RANDOM>,
739        qr'\$\{?(OS|MACH)TYPE\}?\b'   => q<$(OS|MACH)TYPE>,
740        qr'\$\{?HOST(TYPE|NAME)\}?\b' => q<$HOST(TYPE|NAME)>,
741        qr'\$\{?DIRSTACK\}?\b'        => q<$DIRSTACK>,
742        qr'\$\{?EUID\}?\b'            => q<$EUID should be "$(id -u)">,
743        qr'\$\{?UID\}?\b'             => q<$UID should be "$(id -ru)">,
744        qr'\$\{?SECONDS\}?\b'         => q<$SECONDS>,
745        qr'\$\{?BASH_[A-Z]+\}?\b'     => q<$BASH_SOMETHING>,
746        qr'\$\{?SHELLOPTS\}?\b'       => q<$SHELLOPTS>,
747        qr'\$\{?PIPESTATUS\}?\b'      => q<$PIPESTATUS>,
748        qr'\$\{?SHLVL\}?\b'           => q<$SHLVL>,
749        qr'\$\{?FUNCNAME\}?\b'        => q<$FUNCNAME>,
750        qr'\$\{?TMOUT\}?\b'           => q<$TMOUT>,
751        qr'(?:^|\s+)TMOUT='           => q<TMOUT=>,
752        qr'\$\{?TIMEFORMAT\}?\b'      => q<$TIMEFORMAT>,
753        qr'(?:^|\s+)TIMEFORMAT='      => q<TIMEFORMAT=>,
754        qr'(?<![$\\])\$\{?_\}?\b'     => q<$_>,
755        qr'(?:^|\s+)GLOBIGNORE='      => q<GLOBIGNORE=>,
756        qr'<<<'                       => q<\<\<\< here string>,
757        $LEADIN
758          . qr'echo\s+(?:-[^e\s]+\s+)?\"[^\"]*(\\[abcEfnrtv0])+.*?[\"]' =>
759          q<unsafe echo with backslash>,
760        qr'\$\(\([\s\w$*/+-]*\w\+\+.*?\)\)' =>
761          q<'$((n++))' should be '$n; $((n=n+1))'>,
762        qr'\$\(\([\s\w$*/+-]*\+\+\w.*?\)\)' =>
763          q<'$((++n))' should be '$((n=n+1))'>,
764        qr'\$\(\([\s\w$*/+-]*\w\-\-.*?\)\)' =>
765          q<'$((n--))' should be '$n; $((n=n-1))'>,
766        qr'\$\(\([\s\w$*/+-]*\-\-\w.*?\)\)' =>
767          q<'$((--n))' should be '$((n=n-1))'>,
768        qr'\$\(\([\s\w$*/+-]*\*\*.*?\)\)' => q<exponentiation is not POSIX>,
769        $LEADIN . qr'printf\s["\'][^"\']*?%q.+?["\']' => q<printf %q>,
770    );
771
772    %singlequote_bashisms = (
773        $LEADIN
774          . qr'echo\s+(?:-[^e\s]+\s+)?\'[^\']*(\\[abcEfnrtv0])+.*?[\']' =>
775          q<unsafe echo with backslash>,
776        $LEADIN
777          . qr'source\s+[\"\']?(?:\.\/|\/|\$|[\w~.-])\S*' =>
778          q<should be '.', not 'source'>,
779    );
780
781    if ($opt_echo) {
782        $bashisms{ $LEADIN . qr'echo\s+-[A-Za-z]*n' } = q<echo -n>;
783    }
784    if ($opt_posix) {
785        $bashisms{ $LEADIN . qr'local\s+\w+(\s+\W|\s*[;&|)]|$)' }
786          = q<local foo>;
787        $bashisms{ $LEADIN . qr'local\s+\w+=' }      = q<local foo=bar>;
788        $bashisms{ $LEADIN . qr'local\s+\w+\s+\w+' } = q<local x y>;
789        $bashisms{ $LEADIN . qr'((?:test|\[)\s+.+\s-[ao])\s' } = q<test -a/-o>;
790        $bashisms{ $LEADIN . qr'kill\s+-[^sl]\w*' } = q<kill -[0-9] or -[A-Z]>;
791        $bashisms{ $LEADIN . qr'trap\s+["\']?.*["\']?\s+.*[1-9]' }
792          = q<trap with signal numbers>;
793    }
794
795    if ($makefile) {
796        $string_bashisms{qr'(\$\(|\`)\s*\<\s*([^\s\)]{2,}|[^DF])\s*(\)|\`)'}
797          = q<'$(\< foo)' should be '$(cat foo)'>;
798    } else {
799        $bashisms{ $LEADIN . qr'\w+\+=' } = q<should be VAR="${VAR}foo">;
800        $string_bashisms{qr'(\$\(|\`)\s*\<\s*\S+\s*(\)|\`)'}
801          = q<'$(\< foo)' should be '$(cat foo)'>;
802    }
803
804    if ($opt_extra) {
805        $string_bashisms{qr'\$\{?BASH\}?\b'}            = q<$BASH>;
806        $string_bashisms{qr'(?:^|\s+)RANDOM='}          = q<RANDOM=>;
807        $string_bashisms{qr'(?:^|\s+)(OS|MACH)TYPE='}   = q<(OS|MACH)TYPE=>;
808        $string_bashisms{qr'(?:^|\s+)HOST(TYPE|NAME)='} = q<HOST(TYPE|NAME)=>;
809        $string_bashisms{qr'(?:^|\s+)DIRSTACK='}        = q<DIRSTACK=>;
810        $string_bashisms{qr'(?:^|\s+)EUID='}            = q<EUID=>;
811        $string_bashisms{qr'(?:^|\s+)UID='}             = q<UID=>;
812        $string_bashisms{qr'(?:^|\s+)BASH(_[A-Z]+)?='}  = q<BASH(_SOMETHING)=>;
813        $string_bashisms{qr'(?:^|\s+)SHELLOPTS='}       = q<SHELLOPTS=>;
814        $string_bashisms{qr'\$\{?POSIXLY_CORRECT\}?\b'} = q<$POSIXLY_CORRECT>;
815    }
816}
817