~ubuntu-branches/debian/squeeze/bugzilla/squeeze

« back to all changes in this revision

Viewing changes to t/008filter.t

  • Committer: Bazaar Package Importer
  • Author(s): Raphael Bossek
  • Date: 2008-06-27 22:34:34 UTC
  • mfrom: (1.1.7 upstream)
  • Revision ID: james.westby@ubuntu.com-20080627223434-0ib57vstn43bb4a3
Tags: 3.0.4.1-1
* Update of French, Russian and German translations. (closes: #488251)
* Added Bulgarian and Belarusian translations.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
# -*- Mode: perl; indent-tabs-mode: nil -*-
2
 
#
3
 
# The contents of this file are subject to the Mozilla Public
4
 
# License Version 1.1 (the "License"); you may not use this file
5
 
# except in compliance with the License. You may obtain a copy of
6
 
# the License at http://www.mozilla.org/MPL/
7
 
#
8
 
# Software distributed under the License is distributed on an "AS
9
 
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
10
 
# implied. See the License for the specific language governing
11
 
# rights and limitations under the License.
12
 
#
13
 
# The Original Code are the Bugzilla tests.
14
 
#
15
 
# The Initial Developer of the Original Code is Jacob Steenhagen.
16
 
# Portions created by Jacob Steenhagen are
17
 
# Copyright (C) 2001 Jacob Steenhagen. All
18
 
# Rights Reserved.
19
 
#
20
 
# Contributor(s): Gervase Markham <gerv@gerv.net>
21
 
 
22
 
#################
23
 
#Bugzilla Test 8#
24
 
#####filter######
25
 
 
26
 
# This test scans all our templates for every directive. Having eliminated
27
 
# those which cannot possibly cause XSS problems, it then checks the rest
28
 
# against the safe list stored in the filterexceptions.pl file. 
29
 
 
30
 
# Sample exploit code: '>"><script>alert('Oh dear...')</script>
31
 
 
32
 
use strict;
33
 
use lib 't';
34
 
 
35
 
use vars qw(%safe);
36
 
 
37
 
use Support::Templates;
38
 
use File::Spec;
39
 
use Test::More tests => $Support::Templates::num_actual_files;
40
 
use Cwd;
41
 
 
42
 
# Undefine the record separator so we can read in whole files at once
43
 
my $oldrecsep = $/;
44
 
my $topdir = cwd;
45
 
$/ = undef;
46
 
 
47
 
foreach my $path (@Support::Templates::include_paths) {
48
 
    $path =~ s|\\|/|g if $^O eq 'MSWin32';  # convert \ to / in path if on windows
49
 
    $path =~ m|template/([^/]+)/([^/]+)|;
50
 
    my $lang = $1;
51
 
    my $flavor = $2;
52
 
 
53
 
    chdir $topdir; # absolute path
54
 
    my @testitems = Support::Templates::find_actual_files($path);
55
 
    chdir $topdir; # absolute path
56
 
    
57
 
    next unless @testitems;
58
 
    
59
 
    # Some people require this, others don't. No-one knows why.
60
 
    chdir $path; # relative path
61
 
    
62
 
    # We load a %safe list of acceptable exceptions.
63
 
    if (!-r "filterexceptions.pl") {
64
 
        ok(0, "$path has templates but no filterexceptions.pl file. --ERROR");
65
 
        next;
66
 
    }
67
 
    else {
68
 
        do "filterexceptions.pl";
69
 
        if ($^O eq 'MSWin32') {
70
 
          # filterexceptions.pl uses / separated paths, while 
71
 
          # find_actual_files returns \ separated ones on Windows.
72
 
          # Here, we convert the filter exception hash to use \.
73
 
          foreach my $file (keys %safe) {
74
 
            my $orig_file = $file;
75
 
            $file =~ s|/|\\|g;
76
 
            if ($file ne $orig_file) {
77
 
              $safe{$file} = $safe{$orig_file};
78
 
              delete $safe{$orig_file};
79
 
            }
80
 
          }
81
 
        }
82
 
    }
83
 
    
84
 
    # We preprocess the %safe hash of lists into a hash of hashes. This allows
85
 
    # us to flag which members were not found, and report that as a warning, 
86
 
    # thereby keeping the lists clean.
87
 
    foreach my $file (keys %safe) {
88
 
        my $list = $safe{$file};
89
 
        $safe{$file} = {};
90
 
        foreach my $directive (@$list) {
91
 
            $safe{$file}{$directive} = 0;    
92
 
        }
93
 
    }
94
 
 
95
 
    foreach my $file (@testitems) {
96
 
        # There are some files we don't check, because there is no need to
97
 
        # filter their contents due to their content-type.
98
 
        if ($file =~ /\.(txt|png)\.tmpl$/) {
99
 
            ok(1, "($lang/$flavor) $file is filter-safe");
100
 
            next;
101
 
        }
102
 
        
103
 
        # Read the entire file into a string
104
 
        open (FILE, "<$file") || die "Can't open $file: $!\n";    
105
 
        my $slurp = <FILE>;
106
 
        close (FILE);
107
 
 
108
 
        my @unfiltered;
109
 
 
110
 
        # /g means we execute this loop for every match
111
 
        # /s means we ignore linefeeds in the regexp matches
112
 
        while ($slurp =~ /\[%(.*?)%\]/gs) {
113
 
            my $directive = $1;
114
 
 
115
 
            my @lineno = ($` =~ m/\n/gs);
116
 
            my $lineno = scalar(@lineno) + 1;
117
 
 
118
 
            if (!directive_ok($file, $directive)) {
119
 
 
120
 
              # This intentionally makes no effort to eliminate duplicates; to do
121
 
              # so would merely make it more likely that the user would not 
122
 
              # escape all instances when attempting to correct an error.
123
 
              push(@unfiltered, "$lineno:$directive");
124
 
            }
125
 
        }  
126
 
 
127
 
        my $fullpath = File::Spec->catfile($path, $file);
128
 
        
129
 
        if (@unfiltered) {
130
 
            my $uflist = join("\n  ", @unfiltered);
131
 
            ok(0, "($lang/$flavor) $fullpath has unfiltered directives:\n  $uflist\n--ERROR");
132
 
        }
133
 
        else {
134
 
            # Find any members of the exclusion list which were not found
135
 
            my @notfound;
136
 
            foreach my $directive (keys %{$safe{$file}}) {
137
 
                push(@notfound, $directive) if ($safe{$file}{$directive} == 0);    
138
 
            }
139
 
 
140
 
            if (@notfound) {
141
 
                my $nflist = join("\n  ", @notfound);
142
 
                ok(0, "($lang/$flavor) $fullpath - filterexceptions.pl has extra members:\n  $nflist\n" . 
143
 
                                                                  "--WARNING");
144
 
            }
145
 
            else {
146
 
                # Don't use the full path here - it's too long and unwieldy.
147
 
                ok(1, "($lang/$flavor) $file is filter-safe");
148
 
            }
149
 
        }
150
 
    }
151
 
}
152
 
 
153
 
sub directive_ok {
154
 
    my ($file, $directive) = @_;
155
 
 
156
 
    # Comments
157
 
    return 1 if $directive =~ /^[+-]?#/;        
158
 
 
159
 
    # Remove any leading/trailing + or - and whitespace.
160
 
    $directive =~ s/^[+-]?\s*//;
161
 
    $directive =~ s/\s*[+-]?$//;
162
 
 
163
 
    # Empty directives are ok; they are usually line break helpers
164
 
    return 1 if $directive eq '';
165
 
 
166
 
    # Make sure we're not looking for ./ in the $safe hash
167
 
    $file =~ s#^\./##;
168
 
 
169
 
    # Exclude those on the nofilter list
170
 
    if (defined($safe{$file}{$directive})) {
171
 
        $safe{$file}{$directive}++;
172
 
        return 1;
173
 
    };
174
 
 
175
 
    # Directives
176
 
    return 1 if $directive =~ /^(IF|END|UNLESS|FOREACH|PROCESS|INCLUDE|
177
 
                                 BLOCK|USE|ELSE|NEXT|LAST|DEFAULT|FLUSH|
178
 
                                 ELSIF|SET|SWITCH|CASE|WHILE|RETURN|STOP|
179
 
                                 TRY|CATCH|FINAL|THROW|CLEAR|MACRO)/x;
180
 
 
181
 
    # ? :
182
 
    if ($directive =~ /.+\?(.+):(.+)/) {
183
 
        return 1 if directive_ok($file, $1) && directive_ok($file, $2);
184
 
    }
185
 
 
186
 
    # + - * /
187
 
    return 1 if $directive =~ /[+\-*\/]/;
188
 
 
189
 
    # Numbers
190
 
    return 1 if $directive =~ /^[0-9]+$/;
191
 
 
192
 
    # Simple assignments
193
 
    return 1 if $directive =~ /^[\w\.\$]+\s+=\s+/;
194
 
 
195
 
    # Conditional literals with either sort of quotes 
196
 
    # There must be no $ in the string for it to be a literal
197
 
    return 1 if $directive =~ /^(["'])[^\$]*[^\\]\1/;
198
 
    return 1 if $directive =~ /^(["'])\1/;
199
 
 
200
 
    # Special values always used for numbers
201
 
    return 1 if $directive =~ /^[ijkn]$/;
202
 
    return 1 if $directive =~ /^count$/;
203
 
    
204
 
    # Params
205
 
    return 1 if $directive =~ /^Param\(/;
206
 
    
207
 
    # Hooks
208
 
    return 1 if $directive =~ /^Hook.process\(/;
209
 
 
210
 
    # Other functions guaranteed to return OK output
211
 
    return 1 if $directive =~ /^(time2str|url)\(/;
212
 
 
213
 
    # Safe Template Toolkit virtual methods
214
 
    return 1 if $directive =~ /\.(length$|size$|push\()/;
215
 
 
216
 
    # Special Template Toolkit loop variable
217
 
    return 1 if $directive =~ /^loop\.(index|count)$/;
218
 
    
219
 
    # Branding terms
220
 
    return 1 if $directive =~ /^terms\./;
221
 
            
222
 
    # Things which are already filtered
223
 
    # Note: If a single directive prints two things, and only one is 
224
 
    # filtered, we may not catch that case.
225
 
    return 1 if $directive =~ /FILTER\ (html|csv|js|base64|url_quote|css_class_quote|
226
 
                                        ics|quoteUrls|time|uri|xml|lower|html_light|
227
 
                                        obsolete|inactive|closed|unitconvert|
228
 
                                        txt|none)\b/x;
229
 
 
230
 
    return 0;
231
 
}
232
 
 
233
 
$/ = $oldrecsep;
234
 
 
235
 
exit 0;