diff options
Diffstat (limited to 't/002goodperl.t')
| -rw-r--r-- | t/002goodperl.t | 273 |
1 files changed, 144 insertions, 129 deletions
diff --git a/t/002goodperl.t b/t/002goodperl.t index d1858361f..b61c0ad85 100644 --- a/t/002goodperl.t +++ b/t/002goodperl.t @@ -14,160 +14,175 @@ use 5.10.1; use strict; use warnings; -use lib 't'; +use lib qw(. lib t); use Support::Files; -use Test::More tests => (scalar(@Support::Files::testitems) - + scalar(@Support::Files::test_files)) * 6; +use Test::More tests => + (scalar(@Support::Files::testitems) + scalar(@Support::Files::test_files)) + * 6; -my @testitems = (@Support::Files::test_files, @Support::Files::testitems); +my @testitems = (@Support::Files::test_files, @Support::Files::testitems); my @require_taint = qw(email_in.pl importxml.pl mod_perl.pl whine.pl); foreach my $file (@testitems) { - $file =~ s/\s.*$//; # nuke everything after the first space (#comment) - next if (!$file); # skip null entries - if (! open (FILE, $file)) { - ok(0,"could not open $file --WARNING"); + $file =~ s/\s.*$//; # nuke everything after the first space (#comment) + next if (!$file); # skip null entries + if (!open(FILE, $file)) { + ok(0, "could not open $file --WARNING"); + } + my $file_line1 = <FILE>; + close(FILE); + + $file =~ m/.*\.(.*)/; + my $ext = $1; + + if ($file_line1 !~ m/^#\!/) { + ok(1, "$file does not have a shebang"); + } + else { + my $flags; + if (!defined $ext || $ext eq "pl") { + + # standalone programs aren't taint checked yet + if (grep { $file eq $_ } @require_taint) { + $flags = 'T'; + } + else { + $flags = ''; + } } - my $file_line1 = <FILE>; - close (FILE); - - $file =~ m/.*\.(.*)/; - my $ext = $1; - - if ($file_line1 !~ m/^#\!/) { - ok(1,"$file does not have a shebang"); - } else { - my $flags; - if (!defined $ext || $ext eq "pl") { - # standalone programs aren't taint checked yet - if (grep { $file eq $_ } @require_taint) { - $flags = 'T'; - } - else { - $flags = ''; - } - } elsif ($ext eq "pm") { - ok(0, "$file is a module, but has a shebang"); - next; - } elsif ($ext eq "cgi") { - # cgi files must be taint checked - $flags = 'T'; - } else { - ok(0, "$file has shebang but unknown extension"); - next; - } - - if ($file_line1 =~ m#^\#\!/usr/bin/perl(?:\s-(\w+))?$#) { - my $file_flags = $1 || ''; - if ($flags eq $file_flags) { - ok(1, "$file uses standard perl location" . ($flags ? " and -$flags flag" : "")); - } - elsif ($flags) { - ok(0, "$file is MISSING -$flags flag --WARNING"); - } - else { - ok(0, "$file has unexpected -$file_flags flag --WARNING"); - } - } else { - ok(0,"$file uses non-standard perl location"); - } + elsif ($ext eq "pm") { + ok(0, "$file is a module, but has a shebang"); + next; } -} + elsif ($ext eq "cgi") { -foreach my $file (@testitems) { - my $found_use_perl = 0; - my $found_use_strict = 0; - my $found_use_warnings = 0; - - $file =~ s/\s.*$//; # nuke everything after the first space (#comment) - next if (!$file); # skip null entries - if (! open (FILE, $file)) { - ok(0,"could not open $file --WARNING"); - next; - } - while (my $file_line = <FILE>) { - $found_use_perl = 1 if $file_line =~ m/^\s*use 5.10.1/; - $found_use_strict = 1 if $file_line =~ m/^\s*use strict/; - $found_use_warnings = 1 if $file_line =~ m/^\s*use warnings/; - last if ($found_use_perl && $found_use_strict && $found_use_warnings); + # cgi files must be taint checked + $flags = 'T'; } - close (FILE); - if ($found_use_perl) { - ok(1,"$file requires Perl 5.10.1"); - } else { - ok(0,"$file DOES NOT require Perl 5.10.1 --WARNING"); + else { + ok(0, "$file has shebang but unknown extension"); + next; } - if ($found_use_strict) { - ok(1,"$file uses strict"); - } else { - ok(0,"$file DOES NOT use strict --WARNING"); + if ($file_line1 =~ m#^\#\!/usr/bin/perl(?:\s-(\w+))?$#) { + my $file_flags = $1 || ''; + if ($flags eq $file_flags) { + ok(1, + "$file uses standard perl location" . ($flags ? " and -$flags flag" : "")); + } + elsif ($flags) { + ok(0, "$file is MISSING -$flags flag --WARNING"); + } + else { + ok(0, "$file has unexpected -$file_flags flag --WARNING"); + } } - - if ($found_use_warnings) { - ok(1,"$file uses warnings"); - } else { - ok(0,"$file DOES NOT use warnings --WARNING"); + else { + ok(0, "$file uses non-standard perl location"); } + } +} + +foreach my $file (@testitems) { + my $found_use_perl = 0; + my $found_use_strict = 0; + my $found_use_warnings = 0; + + $file =~ s/\s.*$//; # nuke everything after the first space (#comment) + next if (!$file); # skip null entries + if (!open(FILE, $file)) { + ok(0, "could not open $file --WARNING"); + next; + } + while (my $file_line = <FILE>) { + $found_use_perl = 1 if $file_line =~ m/^\s*use 5.10.1/; + $found_use_strict = 1 if $file_line =~ m/^\s*use strict/; + $found_use_warnings = 1 if $file_line =~ m/^\s*use warnings/; + last if ($found_use_perl && $found_use_strict && $found_use_warnings); + } + close(FILE); + if ($found_use_perl) { + ok(1, "$file requires Perl 5.10.1"); + } + else { + ok(0, "$file DOES NOT require Perl 5.10.1 --WARNING"); + } + + if ($found_use_strict) { + ok(1, "$file uses strict"); + } + else { + ok(0, "$file DOES NOT use strict --WARNING"); + } + + if ($found_use_warnings) { + ok(1, "$file uses warnings"); + } + else { + ok(0, "$file DOES NOT use warnings --WARNING"); + } } # Check to see that all error messages use tags (for l10n reasons.) foreach my $file (@testitems) { - $file =~ s/\s.*$//; # nuke everything after the first space (#comment) - next if (!$file); # skip null entries - if (! open (FILE, $file)) { - ok(0,"could not open $file --WARNING"); - next; + $file =~ s/\s.*$//; # nuke everything after the first space (#comment) + next if (!$file); # skip null entries + if (!open(FILE, $file)) { + ok(0, "could not open $file --WARNING"); + next; + } + my $lineno = 0; + my $error = 0; + + while (!$error && (my $file_line = <FILE>)) { + $lineno++; + if ($file_line =~ /Throw.*Error\("(.*?)"/) { + if ($1 =~ /\s/) { + ok( + 0, "$file has a Throw*Error call on line $lineno + which doesn't use a tag --ERROR" + ); + $error = 1; + } } - my $lineno = 0; - my $error = 0; - - while (!$error && (my $file_line = <FILE>)) { - $lineno++; - if ($file_line =~ /Throw.*Error\("(.*?)"/) { - if ($1 =~ /\s/) { - ok(0,"$file has a Throw*Error call on line $lineno - which doesn't use a tag --ERROR"); - $error = 1; - } - } - } - - ok(1,"$file uses Throw*Error calls correctly") if !$error; - - close(FILE); + } + + ok(1, "$file uses Throw*Error calls correctly") if !$error; + + close(FILE); } # Forbird the { foo => $cgi->param() } syntax, for security reasons. foreach my $file (@testitems) { - $file =~ s/\s.*$//; # nuke everything after the first space (#comment) - next unless $file; # skip null entries - if (!open(FILE, $file)) { - ok(0, "could not open $file --WARNING"); - next; + $file =~ s/\s.*$//; # nuke everything after the first space (#comment) + next unless $file; # skip null entries + if (!open(FILE, $file)) { + ok(0, "could not open $file --WARNING"); + next; + } + my $lineno = 0; + my @unsafe_args; + + while (my $file_line = <FILE>) { + $lineno++; + $file_line =~ s/^\s*(.+)\s*$/$1/; # Remove leading and trailing whitespaces. + if ($file_line =~ /^[^#]+=> \$cgi\->param/) { + push(@unsafe_args, "$file_line on line $lineno"); } - my $lineno = 0; - my @unsafe_args; - - while (my $file_line = <FILE>) { - $lineno++; - $file_line =~ s/^\s*(.+)\s*$/$1/; # Remove leading and trailing whitespaces. - if ($file_line =~ /^[^#]+=> \$cgi\->param/) { - push(@unsafe_args, "$file_line on line $lineno"); - } - } - - if (@unsafe_args) { - ok(0, "$file incorrectly passes a CGI argument to a hash --ERROR\n" . - join("\n", @unsafe_args)); - } - else { - ok(1, "$file has no vulnerable hash syntax"); - } - - close(FILE); + } + + if (@unsafe_args) { + ok(0, + "$file incorrectly passes a CGI argument to a hash --ERROR\n" + . join("\n", @unsafe_args)); + } + else { + ok(1, "$file has no vulnerable hash syntax"); + } + + close(FILE); } exit 0; |