# This Source Code Form is subject to the terms of the Mozilla Public # License, v. 2.0. If a copy of the MPL was not distributed with this # file, You can obtain one at http://mozilla.org/MPL/2.0/. # # This Source Code Form is "Incompatible With Secondary Licenses", as # defined by the Mozilla Public License, v. 2.0. ################# #Bugzilla Test 2# ####GoodPerl##### use 5.14.0; use strict; use warnings; use lib qw(. lib local/lib/perl5 t); use Support::Files; use Test::More tests => (scalar(@Support::Files::testitems) + scalar(@Support::Files::test_files)) * 6; 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"); } 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' || $ext eq 'psgi') { # 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"); } } } 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\.14\.0/; $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.14.0"); } else { ok(0,"$file DOES NOT require Perl 5.14.0 --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; } 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); } # 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; } 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); } exit 0;