diff options
Diffstat (limited to 't/008filter.t')
| -rw-r--r-- | t/008filter.t | 310 |
1 files changed, 157 insertions, 153 deletions
diff --git a/t/008filter.t b/t/008filter.t index f0a26d13f..b60a97579 100644 --- a/t/008filter.t +++ b/t/008filter.t @@ -11,7 +11,7 @@ # This test scans all our templates for every directive. Having eliminated # those which cannot possibly cause XSS problems, it then checks the rest -# against the safe list stored in the filterexceptions.pl file. +# against the safe list stored in the filterexceptions.pl file. # Sample exploit code: '>"><script>alert('Oh dear...')</script> @@ -29,192 +29,196 @@ use Cwd; # Undefine the record separator so we can read in whole files at once my $oldrecsep = $/; -my $topdir = cwd; +my $topdir = cwd; $/ = undef; our %safe; foreach my $path (@Support::Templates::include_paths) { - $path =~ s|\\|/|g if ON_WINDOWS; # convert \ to / in path if on windows - $path =~ m|template/([^/]+)/([^/]+)|; - my $lang = $1; - my $flavor = $2; - - chdir $topdir; # absolute path - my @testitems = Support::Templates::find_actual_files($path); - chdir $topdir; # absolute path - - next unless @testitems; - - # Some people require this, others don't. No-one knows why. - chdir $path; # relative path - - # We load a %safe list of acceptable exceptions. - if (-r "filterexceptions.pl") { - do "filterexceptions.pl"; - if (ON_WINDOWS) { - # filterexceptions.pl uses / separated paths, while - # find_actual_files returns \ separated ones on Windows. - # Here, we convert the filter exception hash to use \. - foreach my $file (keys %safe) { - my $orig_file = $file; - $file =~ s|/|\\|g; - if ($file ne $orig_file) { - $safe{$file} = $safe{$orig_file}; - delete $safe{$orig_file}; - } - } + $path =~ s|\\|/|g if ON_WINDOWS; # convert \ to / in path if on windows + $path =~ m|template/([^/]+)/([^/]+)|; + my $lang = $1; + my $flavor = $2; + + chdir $topdir; # absolute path + my @testitems = Support::Templates::find_actual_files($path); + chdir $topdir; # absolute path + + next unless @testitems; + + # Some people require this, others don't. No-one knows why. + chdir $path; # relative path + + # We load a %safe list of acceptable exceptions. + if (-r "filterexceptions.pl") { + do "filterexceptions.pl"; + if (ON_WINDOWS) { + + # filterexceptions.pl uses / separated paths, while + # find_actual_files returns \ separated ones on Windows. + # Here, we convert the filter exception hash to use \. + foreach my $file (keys %safe) { + my $orig_file = $file; + $file =~ s|/|\\|g; + if ($file ne $orig_file) { + $safe{$file} = $safe{$orig_file}; + delete $safe{$orig_file}; } + } } - - # We preprocess the %safe hash of lists into a hash of hashes. This allows - # us to flag which members were not found, and report that as a warning, - # thereby keeping the lists clean. - foreach my $file (keys %safe) { - if (ref $safe{$file} eq 'ARRAY') { - my $list = $safe{$file}; - $safe{$file} = {}; - foreach my $directive (@$list) { - $safe{$file}{$directive} = 0; - } - } + } + + # We preprocess the %safe hash of lists into a hash of hashes. This allows + # us to flag which members were not found, and report that as a warning, + # thereby keeping the lists clean. + foreach my $file (keys %safe) { + if (ref $safe{$file} eq 'ARRAY') { + my $list = $safe{$file}; + $safe{$file} = {}; + foreach my $directive (@$list) { + $safe{$file}{$directive} = 0; + } } + } - foreach my $file (@testitems) { - # There are some files we don't check, because there is no need to - # filter their contents due to their content-type. - if ($file =~ /\.(pm|txt|rst|png)\.tmpl$/) { - ok(1, "($lang/$flavor) $file is filter-safe"); - next; - } + foreach my $file (@testitems) { - # Read the entire file into a string - open (FILE, "<$file") || die "Can't open $file: $!\n"; - my $slurp = <FILE>; - close (FILE); + # There are some files we don't check, because there is no need to + # filter their contents due to their content-type. + if ($file =~ /\.(pm|txt|rst|png)\.tmpl$/) { + ok(1, "($lang/$flavor) $file is filter-safe"); + next; + } - my @unfiltered; + # Read the entire file into a string + open(FILE, "<$file") || die "Can't open $file: $!\n"; + my $slurp = <FILE>; + close(FILE); - # /g means we execute this loop for every match - # /s means we ignore linefeeds in the regexp matches - while ($slurp =~ /\[%(?:-|\+|~|=)?(.*?)(?:-|\+|~|=)?%\]/gs) { - my $directive = $1; + my @unfiltered; - my @lineno = ($` =~ m/\n/gs); - my $lineno = scalar(@lineno) + 1; + # /g means we execute this loop for every match + # /s means we ignore linefeeds in the regexp matches + while ($slurp =~ /\[%(?:-|\+|~|=)?(.*?)(?:-|\+|~|=)?%\]/gs) { + my $directive = $1; - if (!directive_ok($file, $directive)) { + my @lineno = ($` =~ m/\n/gs); + my $lineno = scalar(@lineno) + 1; - # This intentionally makes no effort to eliminate duplicates; to do - # so would merely make it more likely that the user would not - # escape all instances when attempting to correct an error. - push(@unfiltered, "$lineno:$directive"); - } - } + if (!directive_ok($file, $directive)) { - my $fullpath = File::Spec->catfile($path, $file); - - if (@unfiltered) { - my $uflist = join("\n ", @unfiltered); - ok(0, "($lang/$flavor) $fullpath has unfiltered directives:\n $uflist\n--ERROR"); - } - else { - # Find any members of the exclusion list which were not found - my @notfound; - foreach my $directive (keys %{$safe{$file}}) { - push(@notfound, $directive) if ($safe{$file}{$directive} == 0); - } - - if (@notfound) { - my $nflist = join("\n ", @notfound); - ok(0, "($lang/$flavor) $fullpath - filterexceptions.pl has extra members:\n $nflist\n" . - "--WARNING"); - } - else { - # Don't use the full path here - it's too long and unwieldy. - ok(1, "($lang/$flavor) $file is filter-safe"); - } - } + # This intentionally makes no effort to eliminate duplicates; to do + # so would merely make it more likely that the user would not + # escape all instances when attempting to correct an error. + push(@unfiltered, "$lineno:$directive"); + } } + + my $fullpath = File::Spec->catfile($path, $file); + + if (@unfiltered) { + my $uflist = join("\n ", @unfiltered); + ok(0, + "($lang/$flavor) $fullpath has unfiltered directives:\n $uflist\n--ERROR"); + } + else { + # Find any members of the exclusion list which were not found + my @notfound; + foreach my $directive (keys %{$safe{$file}}) { + push(@notfound, $directive) if ($safe{$file}{$directive} == 0); + } + + if (@notfound) { + my $nflist = join("\n ", @notfound); + ok(0, + "($lang/$flavor) $fullpath - filterexceptions.pl has extra members:\n $nflist\n" + . "--WARNING"); + } + else { + # Don't use the full path here - it's too long and unwieldy. + ok(1, "($lang/$flavor) $file is filter-safe"); + } + } + } } sub directive_ok { - my ($file, $directive) = @_; + my ($file, $directive) = @_; - # Comments - return 1 if $directive =~ /^#/; + # Comments + return 1 if $directive =~ /^#/; - # Remove any leading/trailing whitespace. - $directive =~ s/^\s*//; - $directive =~ s/\s*$//; + # Remove any leading/trailing whitespace. + $directive =~ s/^\s*//; + $directive =~ s/\s*$//; - # Empty directives are ok; they are usually line break helpers - return 1 if $directive eq ''; + # Empty directives are ok; they are usually line break helpers + return 1 if $directive eq ''; - # Make sure we're not looking for ./ in the $safe hash - $file =~ s#^\./##; + # Make sure we're not looking for ./ in the $safe hash + $file =~ s#^\./##; - # Exclude those on the nofilter list - if (defined($safe{$file}{$directive})) { - $safe{$file}{$directive}++; - return 1; - }; + # Exclude those on the nofilter list + if (defined($safe{$file}{$directive})) { + $safe{$file}{$directive}++; + return 1; + } - # Directives - return 1 if $directive =~ /^(IF|END|UNLESS|FOREACH|PROCESS|INCLUDE| + # Directives + return 1 if $directive =~ /^(IF|END|UNLESS|FOREACH|PROCESS|INCLUDE| BLOCK|USE|ELSE|NEXT|LAST|DEFAULT| ELSIF|SET|SWITCH|CASE|WHILE|RETURN|STOP| TRY|CATCH|FINAL|THROW|CLEAR|MACRO|FILTER)/x; - # ? : - if ($directive =~ /.+\?(.+):(.+)/) { - return 1 if directive_ok($file, $1) && directive_ok($file, $2); - } + # ? : + if ($directive =~ /.+\?(.+):(.+)/) { + return 1 if directive_ok($file, $1) && directive_ok($file, $2); + } + + # + - * / + return 1 if $directive =~ /[+\-*\/]/; + + # Numbers + return 1 if $directive =~ /^[0-9]+$/; + + # Simple assignments + return 1 if $directive =~ /^[\w\.\$\{\}]+\s+=\s+/; + + # Conditional literals with either sort of quotes + # There must be no $ in the string for it to be a literal + return 1 if $directive =~ /^(["'])[^\$]*[^\\]\1/; + return 1 if $directive =~ /^(["'])\1/; + + # Special values always used for numbers + return 1 if $directive =~ /^[ijkn]$/; + return 1 if $directive =~ /^count$/; + + # Params + return 1 if $directive =~ /^Param\(/; + + # Hooks + return 1 if $directive =~ /^Hook.process\(/; + + # Other functions guaranteed to return OK output + return 1 if $directive =~ /^(time2str|url)\(/; + + # Safe Template Toolkit virtual methods + return 1 if $directive =~ /\.(length$|size$|push\(|unshift\(|delete\()/; + + # Special Template Toolkit loop variable + return 1 if $directive =~ /^loop\.(index|count)$/; + + # Branding terms + return 1 if $directive =~ /^terms\./; - # + - * / - return 1 if $directive =~ /[+\-*\/]/; - - # Numbers - return 1 if $directive =~ /^[0-9]+$/; - - # Simple assignments - return 1 if $directive =~ /^[\w\.\$\{\}]+\s+=\s+/; - - # Conditional literals with either sort of quotes - # There must be no $ in the string for it to be a literal - return 1 if $directive =~ /^(["'])[^\$]*[^\\]\1/; - return 1 if $directive =~ /^(["'])\1/; - - # Special values always used for numbers - return 1 if $directive =~ /^[ijkn]$/; - return 1 if $directive =~ /^count$/; - - # Params - return 1 if $directive =~ /^Param\(/; - - # Hooks - return 1 if $directive =~ /^Hook.process\(/; - - # Other functions guaranteed to return OK output - return 1 if $directive =~ /^(time2str|url)\(/; - - # Safe Template Toolkit virtual methods - return 1 if $directive =~ /\.(length$|size$|push\(|unshift\(|delete\()/; - - # Special Template Toolkit loop variable - return 1 if $directive =~ /^loop\.(index|count)$/; - - # Branding terms - return 1 if $directive =~ /^terms\./; - - # Things which are already filtered - # Note: If a single directive prints two things, and only one is - # filtered, we may not catch that case. - return 1 if $directive =~ /FILTER\ (html|csv|js|base64|css_class_quote|ics| + # Things which are already filtered + # Note: If a single directive prints two things, and only one is + # filtered, we may not catch that case. + return 1 if $directive =~ /FILTER\ (html|csv|js|base64|css_class_quote|ics| quoteUrls|time|uri|xml|lower|html_light| obsolete|inactive|closed|unitconvert| txt|html_linebreak|none)\b/x; - return 0; + return 0; } $/ = $oldrecsep; |