File Coverage

blib/lib/HTML/StripScripts.pm

Criterion	Covered	Total	%
statement	367	383	95.8
branch	169	202	83.6
condition	44	55	80.0
subroutine	68	72	94.4
pod	31	31	100.0
total	679	743	91.3

line	stmt	bran	cond	sub	pod	time	code
1							package HTML::StripScripts;
2	10			10		426913	use strict;
	10					26
	10					573
3	10			10		59	use warnings FATAL => 'all';
	10					20
	10					875
4
5	10			10		71	use vars qw($VERSION);
	10					21
	10					54299
6							$VERSION = '1.05';
7
8							=head1 NAME
9
10							HTML::StripScripts - Strip scripting constructs out of HTML
11
12							=head1 SYNOPSIS
13
14							use HTML::StripScripts;
15
16							my $hss = HTML::StripScripts->new({ Context => 'Inline' });
17
18							$hss->input_start_document;
19
20							$hss->input_start('');
21							$hss->input_text('hello, world!');
22							$hss->input_end('');
23
24							$hss->input_end_document;
25
26							print $hss->filtered_document;
27
28							=head1 DESCRIPTION
29
30							This module strips scripting constructs out of HTML, leaving as
31							much non-scripting markup in place as possible. This allows web
32							applications to display HTML originating from an untrusted source
33							without introducing XSS (cross site scripting) vulnerabilities.
34
35							You will probably use L rather than using
36							this module directly.
37
38							The process is based on whitelists of tags, attributes and attribute
39							values. This approach is the most secure against disguised scripting
40							constructs hidden in malicious HTML documents.
41
42							As well as removing scripting constructs, this module ensures that
43							there is a matching end for each start tag, and that the tags are
44							properly nested.
45
46							Previously, in order to customise the output, you needed to subclass
47							C and override methods. Now, most customisation
48							can be done through the C option provided to C. (See
49							examples/declaration/ and examples/tags/ for cases where subclassing is
50							necessary.)
51
52							The HTML document must be parsed into start tags, end tags and
53							text before it can be filtered by this module. Use either
54							L or L instead
55							if you want to input an unparsed HTML document.
56
57							See examples/direct/ for an example of how to feed tokens directly to
58							HTML::StripScripts.
59
60							=head1 CONSTRUCTORS
61
62							=over
63
64							=item new ( CONFIG )
65
66							Creates a new C filter object, bound to a
67							particular filtering policy. If present, the CONFIG parameter
68							must be a hashref. The following keys are recognized (unrecognized
69							keys will be silently ignored).
70
71							$s = HTML::Stripscripts->new({
72							Context => 'Document\|Flow\|Inline\|NoTags',
73							BanList => [qw( br img )] \| {br => '1', img => '1'},
74							BanAllBut => [qw(p div span)],
75							AllowSrc => 0\|1,
76							AllowHref => 0\|1,
77							AllowRelURL => 0\|1,
78							AllowMailto => 0\|1,
79							EscapeFiltered => 0\|1,
80							Rules => { See below for details },
81							});
82
83							=over
84
85							=item C
86
87							A string specifying the context in which the filtered document
88							will be used. This influences the set of tags that will be
89							allowed.
90
91							If present, the C value must be one of:
92
93							=over
94
95							=item C
96
97							If C is C then the filter will allow a full
98							HTML document, including the C tag and C and C
99							sections.
100
101							=item C
102
103							If C is C then most of the cosmetic tags that one
104							would expect to find in a document body are allowed, including
105							lists and tables but not including forms.
106
107							=item C
108
109							If C is C then only inline tags such as C
110							and C are allowed.
111
112							=item C
113
114							If C is C then no tags are allowed.
115
116							=back
117
118							The default C value is C.
119
120							=item C
121
122							If present, this option must be an arrayref or a hashref. Any tag that
123							would normally be allowed (because it presents no XSS hazard) will be
124							blocked if the lowercase name of the tag is in this list.
125
126							For example, in a guestbook application where C tags are used to
127							separate posts, you may wish to prevent posts from including C
128							tags, even though C is not an XSS risk.
129
130							=item C
131
132							If present, this option must be reference to an array holding a list of
133							lowercase tag names. This has the effect of adding all but the listed
134							tags to the ban list, so that only those tags listed will be allowed.
135
136							=item C
137
138							By default, the filter won't allow constructs that cause the browser to
139							fetch things automatically, such as C attributes in C tags.
140							If this option is present and true then those constructs will be
141							allowed.
142
143							=item C
144
145							By default, the filter won't allow constructs that cause the browser to
146							fetch things if the user clicks on something, such as the C
147							attribute in C tags. Set this option to a true value to allow this
148							type of construct.
149
150							=item C
151
152							By default, the filter won't allow relative URLs such as C<../foo.html>
153							in C and C attribute values. Set this option to a true value
154							to allow them. C and / or C also need to be set to true
155							for this to have any effect.
156
157							=item C
158
159							By default, C links are not allowed. If C is set to
160							a true value, then this construct will be allowed. This can be enabled
161							separately from AllowHref.
162
163							=item C
164
165							By default, any filtered tags are outputted as C<< >>. If
166							C is set to a true value, then the filtered tags are converted
167							to HTML entities.
168
169							For instance:
170
171							--> <br>
172
173							=item C
174
175							The C option provides a very flexible way of customising the filter.
176
177							The focus is safety-first, so it is applied after all of the previous validation.
178							This means that you cannot all malicious data should already have been cleared.
179
180							Rules can be specified for tags and for attributes. Any tag or attribute
181							not explicitly listed will be handled by the default C<*> rules.
182
183							The following is a synopsis of all of the options that you can use to
184							configure rules. Below, an example is broken into sections and explained.
185
186							Rules => {
187
188							tag => 0 \| 1 \| sub { tag_callback }
189							\| {
190							attr => 0 \| 1 \| 'regex' \| qr/regex/ \| sub { attr_callback},
191							'*' => 0 \| 1 \| 'regex' \| qr/regex/ \| sub { attr_callback},
192							required => [qw(attrname attrname)],
193							tag => sub { tag_callback }
194							},
195
196							'*' => 0 \| 1 \| sub { tag_callback }
197							\| {
198							attr => 0 \| 1 \| 'regex' \| qr/regex/ \| sub { attr_callback},
199							'*' => 0 \| 1 \| 'regex' \| qr/regex/ \| sub { attr_callback},
200							tag => sub { tag_callback }
201							}
202
203							}
204
205							EXAMPLE:
206
207							Rules => {
208
209							##########################
210							##### EXPLICIT RULES #####
211							##########################
212
213							## Allow tags, reject tags
214							br => 1,
215							img => 0,
216
217							## Send all tags to a sub
218							div => sub { tag_callback },
219
220							## Allow tags,and allow the 'cite' attribute
221							## All other attributes are handled by the default C<*>
222							blockquote => {
223							cite => 1,
224							},
225
226							## Allow tags, and
227							a => {
228
229							## Allow the 'title' attribute
230							title => 1,
231
232							## Allow the 'href' attribute if it matches the regex
233							href => '^http://yourdomain.com'
234							OR href => qr{^http://yourdomain.com},
235
236							## 'style' attributes are handled by a sub
237							style => sub { attr_callback },
238
239							## All other attributes are rejected
240							'*' => 0,
241
242							## Additionally, the tag should be handled by this sub
243							tag => sub { tag_callback},
244
245							## If the tag doesn't have these attributes, filter the tag
246							required => [qw(href title)],
247
248							},
249
250							##########################
251							##### DEFAULT RULES #####
252							##########################
253
254							## The default '*' rule - accepts all the same options as above.
255							## If a tag or attribute is not mentioned above, then the default
256							## rule is applied:
257
258							## Reject all tags
259							'*' => 0,
260
261							## Allow all tags and all attributes
262							'*' => 1,
263
264							## Send all tags to the sub
265							'*' => sub { tag_callback },
266
267							## Allow all tags, reject all attributes
268							'' => { '' => 0 },
269
270							## Allow all tags, and
271							'*' => {
272
273							## Allow the 'title' attribute
274							title => 1,
275
276							## Allow the 'href' attribute if it matches the regex
277							href => '^http://yourdomain.com'
278							OR href => qr{^http://yourdomain.com},
279
280							## 'style' attributes are handled by a sub
281							style => sub { attr_callback },
282
283							## All other attributes are rejected
284							'*' => 0,
285
286							## Additionally, all tags should be handled by this sub
287							tag => sub { tag_callback},
288
289							},
290
291							=over
292
293							=item Tag Callbacks
294
295							sub tag_callback {
296							my ($filter,$element) = (@_);
297
298							$element = {
299							tag => 'tag',
300							content => 'inner_html',
301							attr => {
302							attr_name => 'attr_value',
303							}
304							};
305							return 0 \| 1;
306							}
307
308							A tag callback accepts two parameters, the C<$filter> object and the C$element>.
309							It should return C<0> to completely ignore the tag and its content (which includes
310							any nested HTML tags), or C<1> to accept and output the tag.
311
312							The C<$element> is a hash ref containing the keys:
313
314							=item C
315
316							This is the tagname in lowercase, eg C, C , C. If you set
317							the tag value to an empty string, then the tag will not be outputted, but
318							the tag contents will.
319
320							=item C
321
322							This is the equivalent of DOM's innerHTML. It contains the text content
323							and any HTML tags contained within this element. You can change the content
324							or set it to an empty string so that it is not outputted.
325
326							=item C
327
328							C contains a hashref containing the attribute names and values
329
330							=back
331
332							If for instance, you wanted to replace C<< >> tags with C<< >> tags,
333							you could do this:
334
335							sub b_callback {
336							my ($filter,$element) = @_;
337							$element->{tag} = 'span';
338							$element->{attr}{style} = 'font-weight:bold';
339							return 1;
340							}
341
342							=item Attribute Callbacks
343
344							sub attr_callback {
345							my ( $filter, $tag, $attr_name, $attr_val ) = @_;
346							return undef \| '' \| 'value';
347							}
348
349							Attribute callbacks accept four parameters, the C<$filter> object, the C<$tag>
350							name, the C<$attr_name> and the C<$attr_value>.
351
352							It should return either C to reject the attribute, or the value to be
353							used. An empty string keeps the attribute, but without a value.
354
355							=item C vs C vs C
356
357							It is not necessary to use C or C - everything can be done
358							via C, however it may be simpler to write:
359
360							BanAllBut => [qw(p div span)]
361
362							The logic works as follows:
363
364							* If BanAllBut exists, then ban everything but the tags in the list
365							* Add to the ban list any elements in BanList
366							* Any tags mentioned explicitly in Rules (eg a => 0, br => 1)
367							are added or removed from the BanList
368							* A default rule of { '*' => 0 } would ban all tags except
369							those mentioned in Rules
370							* A default rule of { '*' => 1 } would allow all tags except
371							those disallowed in the ban list, or by explicit rules
372
373							=back
374
375							=cut
376
377							sub new {
378	1487			1487	1	50381	my ( $pkg, $cfg ) = @_;
379
380	1487		66			11379	my $self = bless {}, ref $pkg \|\| $pkg;
381	1487					4280	$self->hss_init($cfg);
382	1487					5024	return $self;
383							}
384
385							=back
386
387							=head1 METHODS
388
389							This class provides the following methods:
390
391							=over
392
393							=item hss_init ()
394
395							This method is called by new() and does the actual initialisation work
396							for the new HTML::StripScripts object.
397
398							=cut
399
400							sub hss_init {
401	1487			1487	1	2208	my ( $self, $cfg ) = @_;
402	1487		100			3400	$cfg \|\|= {};
403
404	1487					3758	$self->{_hssCfg} = $cfg;
405
406	1487					4893	$self->{_hssContext} = $self->init_context_whitelist;
407	1487					4195	$self->{_hssAttrib} = $self->init_attrib_whitelist;
408	1487					3659	$self->{_hssAttVal} = $self->init_attval_whitelist;
409	1487					5024	$self->{_hssStyle} = $self->init_style_whitelist;
410	1487					3364	$self->{_hssDeInter} = $self->init_deinter_whitelist;
411	1487					3822	$self->{_hssBanList} = $self->_hss_prepare_ban_list($cfg);
412	1487					4767	$self->{_hssRules} = $self->_hss_prepare_rules($cfg);
413							}
414
415							=item input_start_document ()
416
417							This method initializes the filter, and must be called once before
418							starting on each HTML document to be filtered.
419
420							=cut
421
422							sub input_start_document {
423	1890			1890	1	117008	my ( $self, $context ) = @_;
424
425	1890		100			18711	$self->{_hssStack} = [ { NAME => '',
426							CTX => $self->{_hssCfg}{Context} \|\| 'Flow',
427							CONTENT => '',
428							}
429							];
430	1890					4079	$self->{_hssOutput} = '';
431
432	1890					4184	$self->output_start_document;
433							}
434
435							=item input_start ( TEXT )
436
437							Handles a start tag from the input document. TEXT must be the
438							full text of the tag, including angle-brackets.
439
440							=cut
441
442							sub input_start {
443	3160			3160	1	12065	my ( $self, $text ) = @_;
444
445	3160	100				7691	$self->_hss_accept_input_start($text) or $self->reject_start($text);
446							}
447
448							sub _hss_accept_input_start {
449	3160			3160		17127	my ( $self, $text ) = @_;
450
451	3160	100				22110	return 0 unless $text =~ m\|^<([a-zA-Z0-9]+)\b(.*)>$\|m;
452	3153					11043	my ( $tag, $attr ) = ( lc $1, $self->strip_nonprintable($2) );
453
454	3153	50				10900	return 0 if $self->{_hssSkipToEnd};
455	3153	50	33			21750	if ( $tag eq 'script' or $tag eq 'style' ) {
456	0					0	$self->{_hssSkipToEnd} = $tag;
457	0					0	return 0;
458							}
459
460	3153	100				8296	return 0 if $self->_hss_tag_is_banned($tag);
461
462	3119					7394	my $allowed_attr = $self->{_hssAttrib}{$tag};
463	3119	100				23106	return 0 unless defined $allowed_attr;
464
465	3117	100				7569	return 0 unless $self->_hss_get_to_valid_context($tag);
466
467	3114					8317	my $default_filters = $self->{_hssRules}{'*'};
468	3114		100			11896	my $tag_filters = $self->{_hssRules}{$tag}
469							\|\| $default_filters;
470
471	3114					4409	my %filtered_attr;
472	3114					26427	while ( $attr
473							=~ s#^\s([\w\-]+)(?:\s=\s(?:([^"'>\s]+)\|"([^"])"\|'([^']*)'))?## )
474							{
475	4365					10842	my $key = lc $1;
476	4365	100				18540	my $val = ( defined $2 ? $self->unquoted_to_canonical_form($2)
		100
		100
477							: defined $3 ? $self->quoted_to_canonical_form($3)
478							: defined $4 ? $self->quoted_to_canonical_form($4)
479							: ''
480							);
481
482	4365					9285	my $value_class = $allowed_attr->{$key};
483	4365	100				10402	next unless defined $value_class;
484
485	4364					10083	my $attval_handler = $self->{_hssAttVal}{$value_class};
486	4364	50				17098	next unless defined $attval_handler;
487
488	4364					4299	my $attr_filter;
489	4364	100				10428	if ($tag_filters) {
490	4115					13420	$attr_filter =
491							$self->_hss_get_attr_filter( $default_filters, $tag_filters,
492							$key );
493
494							# filter == 0
495	4115	100				13622	next unless $attr_filter;
496							}
497
498	3568					5259	my $filtered_value = &{$attval_handler}( $self, $tag, $key, $val );
	3568					10105
499	3568	100				11221	next unless defined $filtered_value;
500
501							# send value to filter if sub
502	3555	100	100			22449	if ( $tag_filters && ref $attr_filter ) {
503	2392					7106	$filtered_value
504							= $attr_filter->( $self, $tag, $key, $filtered_value );
505	2392	100				16784	next unless defined $filtered_value;
506							}
507
508	3026					19755	$filtered_attr{$key} = $filtered_value;
509
510							}
511
512							# Check required attributes
513	3114	100				12486	if ( my $required = $tag_filters->{required} ) {
514	3					6	foreach my $key (@$required) {
515	5	100	66			40	return 0
516							unless defined $filtered_attr{$key} && length($filtered_attr{$key});
517							}
518							}
519
520							# Check for callback
521	3112		66			35163	my $tag_callback = $tag_filters && $tag_filters->{tag}
522							\|\| $default_filters->{tag};
523
524	3112					12487	my $new_context = $self->{_hssContext}{ $self->{_hssStack}[0]{CTX} }{$tag};
525
526	3112					37192	my %stack_entry = ( NAME => $tag,
527							ATTR => \%filtered_attr,
528							CTX => $new_context,
529							CALLBACK => $tag_callback,
530							CONTENT => '',
531							);
532	3112	100				8438	if ( $new_context eq 'EMPTY' ) {
533	1576					28076	$self->output_stack_entry( \%stack_entry );
534							}
535							else {
536	1536					1685	unshift @{ $self->{_hssStack} }, \%stack_entry;
	1536					4631
537
538							}
539
540	3112					27362	return 1;
541							}
542
543							=item input_end ( TEXT )
544
545							Handles an end tag from the input document. TEXT must be the
546							full text of the end tag, including angle-brackets.
547
548							=cut
549
550							sub input_end {
551	1508			1508	1	8189	my ( $self, $text ) = @_;
552
553	1508	100				4819	$self->_hss_accept_input_end($text) or $self->reject_end($text);
554							}
555
556							sub _hss_accept_input_end {
557	1508			1508		1876	my ( $self, $text ) = @_;
558
559	1508	100				7757	return 0 unless $text =~ m#^$#;
560	1505					3214	my $tag = lc $1;
561
562	1505	50				3958	if ( $self->{_hssSkipToEnd} ) {
563	0	0				0	if ( $self->{_hssSkipToEnd} eq $tag ) {
564	0					0	delete $self->{_hssSkipToEnd};
565							}
566	0					0	return 0;
567							}
568
569							# Ignore a close without an open
570	1505	100				1696	return 0 unless grep { $_->{NAME} eq $tag } @{ $self->{_hssStack} };
	3000					11015
	1505					3863
571
572							# Close open tags up to the matching open
573	1478					3368	my @close = ();
574
575	1478					1928	while ( scalar @{ $self->{_hssStack} } ) {
	1480					3984
576	1480					1827	my $entry = shift @{ $self->{_hssStack} };
	1480					3611
577	1480					3942	push @close, $entry;
578	1480					4512	$self->output_stack_entry($entry);
579	1480					3342	$entry->{CONTENT} = '';
580	1480	100				4419	last if $entry->{NAME} eq $tag;
581							}
582
583							# Reopen any we closed early if all that were closed are
584							# configured to be auto de-interleaved.
585	1478	100				2287	unless ( grep { !$self->{_hssDeInter}{ $_->{NAME} } } @close ) {
	1480					10024
586	89					185	pop @close;
587	89					238	unshift @{ $self->{_hssStack} }, @close;
	89					190
588							}
589
590	1478					9255	return 1;
591							}
592
593							=item input_text ( TEXT )
594
595							Handles some non-tag text from the input document.
596
597							=cut
598
599							sub input_text {
600	382			382	1	1610	my ( $self, $text ) = @_;
601
602	382	50				1020	return if $self->{_hssSkipToEnd};
603
604	382					1010	$text = $self->strip_nonprintable($text);
605
606	382	100				1742	if ( $text =~ /^(\s*)$/ ) {
607	2					7	$self->output_text($1);
608	2					5	return;
609							}
610
611	380	100				932	unless ( $self->_hss_get_to_valid_context('CDATA') ) {
612	1					5	$self->reject_text($text);
613	1					3	return;
614							}
615
616	379					1152	my $filtered = $self->filter_text( $self->text_to_canonical_form($text) );
617	379					1284	$self->output_text( $self->canonical_form_to_text($filtered) );
618							}
619
620							=item input_process ( TEXT )
621
622							Handles a processing instruction from the input document.
623
624							=cut
625
626							sub input_process {
627	1			1	1	10	my ( $self, $text ) = @_;
628
629	1					7	$self->reject_process($text);
630							}
631
632							=item input_comment ( TEXT )
633
634							Handles an HTML comment from the input document.
635
636							=cut
637
638							sub input_comment {
639	1			1	1	9	my ( $self, $text ) = @_;
640
641	1					4	$self->reject_comment($text);
642							}
643
644							=item input_declaration ( TEXT )
645
646							Handles an declaration from the input document.
647
648							=cut
649
650							sub input_declaration {
651	1			1	1	11	my ( $self, $text ) = @_;
652
653	1					3	$self->reject_declaration($text);
654							}
655
656							=item input_end_document ()
657
658							Call this method to signal the end of the input document.
659
660							=cut
661
662							sub input_end_document {
663	1890			1890	1	8945	my ($self) = @_;
664
665	1890					3165	delete $self->{_hssSkipToEnd};
666
667	1890					2456	while ( @{ $self->{_hssStack} } > 1 ) {
	1946					7671
668	56					99	$self->output_stack_entry( shift @{ $self->{_hssStack} } );
	56					186
669							}
670
671	1890					4372	$self->output_end_document;
672	1890					2330	my $last_entry = shift @{ $self->{_hssStack} };
	1890					4011
673	1890					4052	$self->{_hssOutput} = $last_entry->{CONTENT};
674	1890					9422	delete $self->{_hssStack};
675
676							}
677
678							=item filtered_document ()
679
680							Returns the filtered document as a string.
681
682							=cut
683
684							sub filtered_document {
685	1890			1890	1	5794	my ($self) = @_;
686	1890					12333	$self->{_hssOutput};
687							}
688
689							=back
690
691							=cut
692
693							=head1 SUBCLASSING
694
695							The only reason for subclassing this module now is to add to the
696							list of accepted tags, attributes and styles (See
697							L). Everything else can be
698							achieved with L.
699
700							The C class is subclassable. Filter objects are plain
701							hashes and C reserves only hash keys that start with
702							C<_hss>. The filter configuration can be set up by invoking the
703							hss_init() method, which takes the same arguments as new().
704
705							=head1 OUTPUT METHODS
706
707							The filter outputs a stream of start tags, end tags, text, comments,
708							declarations and processing instructions, via the following C
709							methods. Subclasses may override these to intercept the filter output.
710
711							The default implementations of the C methods pass the
712							text on to the output() method. The default implementation of the
713							output() method appends the text to a string, which can be fetched with
714							the filtered_document() method once processing is complete.
715
716							If the output() method or the individual C methods are
717							overridden in a subclass, then filtered_document() will not work in
718							that subclass.
719
720							=over
721
722							=item output_start_document ()
723
724							This method gets called once at the start of each HTML document passed
725							through the filter. The default implementation does nothing.
726
727							=cut
728
729	3778			3778	1	6867	sub output_start_document { }
730
731							=item output_end_document ()
732
733							This method gets called once at the end of each HTML document passed
734							through the filter. The default implementation does nothing.
735
736							=cut
737
738							*output_end_document = \&output_start_document;
739
740							=item output_start ( TEXT )
741
742							This method is used to output a filtered start tag.
743
744							=cut
745
746	5108			5108	1	21565	sub output_start { $_[0]->output( $_[1] ) }
747
748							=item output_end ( TEXT )
749
750							This method is used to output a filtered end tag.
751
752							=cut
753
754							*output_end = \&output_start;
755
756							=item output_text ( TEXT )
757
758							This method is used to output some filtered non-tag text.
759
760							=cut
761
762							*output_text = \&output_start;
763
764							=item output_declaration ( TEXT )
765
766							This method is used to output a filtered declaration.
767
768							=cut
769
770							*output_declaration = \&output_start;
771
772							=item output_comment ( TEXT )
773
774							This method is used to output a filtered HTML comment.
775
776							=cut
777
778							*output_comment = \&output_start;
779
780							=item output_process ( TEXT )
781
782							This method is used to output a filtered processing instruction.
783
784							=cut
785
786							*output_process = \&output_start;
787
788							=item output ( TEXT )
789
790							This method is invoked by all of the default C methods. The
791							default implementation appends the text to the string that the
792							filtered_document() method will return.
793
794							=cut
795
796	5111			5111	1	25077	sub output { $_[0]->{_hssStack}[0]{CONTENT} .= $_[1]; }
797
798							=item output_stack_entry ( TEXT )
799
800							This method is invoked when a tag plus all text and nested HTML content
801							within the tag has been processed. It adds the tag plus its content
802							to the content for its parent tag.
803
804							=cut
805
806							sub output_stack_entry {
807	3113			3113	1	5399	my ( $self, $tag ) = @_;
808
809	3113					4516	my %entry;
810	3113					4091	@entry{qw(tag attr content)} = @{$tag}{qw(NAME ATTR CONTENT)};
	3113					15606
811
812	3113	100				25025	if ( my $tag_callback = $tag->{CALLBACK} ) {
813	41	100				136	$tag_callback->( $self, \%entry )
814							or return;
815							}
816
817	3112					6062	my $tagname = $entry{tag};
818	3112					8043	my $filtered_attrs = $self->_hss_join_attribs( $entry{attr} );
819
820	3112	100				11106	if ( $tag->{CTX} eq 'EMPTY' ) {
821	1576	50				8705	$self->output_start("<$tagname$filtered_attrs />")
822							if $entry{tag};
823	1576					4975	return;
824							}
825	1536	100				3442	if ($tagname) {
826	1535					9705	$self->output_start("<$tagname$filtered_attrs>");
827							}
828
829	1536	50				4122	if ( defined $entry{content} ) {
830	1536					4086	$self->{_hssStack}[0]{CONTENT} .= $entry{content};
831							}
832
833	1536	100				3083	if ($tagname) {
834	1535					4776	$self->output_end("");
835							}
836							}
837
838							=back
839
840							=head1 REJECT METHODS
841
842							When the filter encounters something in the input document which it
843							cannot transform into an acceptable construct, it invokes one of
844							the following C methods to put something in the output
845							document to take the place of the unacceptable construct.
846
847							The TEXT parameter is the full text of the unacceptable construct.
848
849							The default implementations of these methods output an HTML comment
850							containing the text C. If L
851							is set to true, then the rejected text is HTML escaped instead.
852
853							Subclasses may override these methods, but should exercise caution.
854							The TEXT parameter is unfiltered input and may contain malicious
855							constructs.
856
857							=over
858
859							=item reject_start ( TEXT )
860
861							=item reject_end ( TEXT )
862
863							=item reject_text ( TEXT )
864
865							=item reject_declaration ( TEXT )
866
867							=item reject_comment ( TEXT )
868
869							=item reject_process ( TEXT )
870
871							=back
872
873							=cut
874
875							sub reject_start {
876	76	100		76	1	599	$_[0]->{_hssCfg}{EscapeFiltered}
877							? $_[0]->output_text( $_[0]->escape_html_metachars( $_[1] ) )
878							: $_[0]->output_comment('');
879							}
880							*reject_end = \&reject_start;
881							*reject_text = \&reject_start;
882							*reject_declaration = \&reject_start;
883							*reject_comment = \&reject_start;
884							*reject_process = \&reject_start;
885
886							=head1 WHITELIST INITIALIZATION METHODS
887
888							The filter refers to various whitelists to determine which constructs
889							are acceptable. To modify these whitelists, subclasses can override
890							the following methods.
891
892							Each method is called once at object initialization time, and must
893							return a reference to a nested data structure. These references are
894							installed into the object, and used whenever the filter needs to refer
895							to a whitelist.
896
897							The default implementations of these methods can be invoked as class
898							methods.
899
900							See examples/tags/ and examples/declaration/ for examples of how to
901							override these methods.
902
903							=over
904
905							=item init_context_whitelist ()
906
907							Returns a reference to the C whitelist, which determines
908							which tags may appear at each point in the document, and which other
909							tags may be nested within them.
910
911							It is a hash, and the keys are context names, such as C and
912							C.
913
914							The values in the hash are hashrefs. The keys in these subhashes are
915							lowercase tag names, and the values are context names, specifying the
916							context that the tag provides to any other tags nested within it.
917
918							The special context C as a value in a subhash indicates that
919							nothing can be nested within that tag.
920
921							=cut
922
923	10			10		132	use vars qw(%_Context);
	10					36
	10					3732
924
925							BEGIN {
926
927	10			10		295	my %pre_content = ( 'br' => 'EMPTY',
928							'span' => 'Inline',
929							'tt' => 'Inline',
930							'i' => 'Inline',
931							'b' => 'Inline',
932							'u' => 'Inline',
933							's' => 'Inline',
934							'strike' => 'Inline',
935							'em' => 'Inline',
936							'strong' => 'Inline',
937							'dfn' => 'Inline',
938							'code' => 'Inline',
939							'q' => 'Inline',
940							'samp' => 'Inline',
941							'kbd' => 'Inline',
942							'var' => 'Inline',
943							'cite' => 'Inline',
944							'abbr' => 'Inline',
945							'acronym' => 'Inline',
946							'ins' => 'Inline',
947							'del' => 'Inline',
948							'a' => 'Inline',
949							'CDATA' => 'CDATA',
950							);
951
952	10					197	my %inline = ( %pre_content,
953							'img' => 'EMPTY',
954							'big' => 'Inline',
955							'small' => 'Inline',
956							'sub' => 'Inline',
957							'sup' => 'Inline',
958							'font' => 'Inline',
959							'nobr' => 'Inline',
960							);
961
962	10					415	my %flow = ( %inline,
963							'ins' => 'Flow',
964							'del' => 'Flow',
965							'div' => 'Flow',
966							'p' => 'Inline',
967							'h1' => 'Inline',
968							'h2' => 'Inline',
969							'h3' => 'Inline',
970							'h4' => 'Inline',
971							'h5' => 'Inline',
972							'h6' => 'Inline',
973							'ul' => 'list',
974							'ol' => 'list',
975							'menu' => 'list',
976							'dir' => 'list',
977							'dl' => 'dt_dd',
978							'address' => 'Inline',
979							'hr' => 'EMPTY',
980							'pre' => 'pre.content',
981							'blockquote' => 'Flow',
982							'center' => 'Flow',
983							'table' => 'table',
984							);
985
986	10					107	my %table = ( 'caption' => 'Inline',
987							'thead' => 'tr_only',
988							'tfoot' => 'tr_only',
989							'tbody' => 'tr_only',
990							'colgroup' => 'colgroup',
991							'col' => 'EMPTY',
992							'tr' => 'th_td',
993							);
994
995	10					35	my %head = ( 'title' => 'NoTags', );
996
997	10					1381	%_Context = ( 'Document' => { 'html' => 'Html' },
998							'Html' => { 'head' => 'Head', 'body' => 'Flow' },
999							'Head' => \%head,
1000							'Inline' => \%inline,
1001							'Flow' => \%flow,
1002							'NoTags' => { 'CDATA' => 'CDATA' },
1003							'pre.content' => \%pre_content,
1004							'table' => \%table,
1005							'list' => { 'li' => 'Flow' },
1006							'dt_dd' => { 'dt' => 'Inline', 'dd' => 'Flow' },
1007							'tr_only' => { 'tr' => 'th_td' },
1008							'colgroup' => { 'col' => 'EMPTY' },
1009							'th_td' => { 'th' => 'Flow', 'td' => 'Flow' },
1010							);
1011							}
1012
1013	1487			1487	1	4369	sub init_context_whitelist { return \%_Context; }
1014
1015							=item init_attrib_whitelist ()
1016
1017							Returns a reference to the C whitelist, which determines which
1018							attributes each tag can have and the values that those attributes can
1019							take.
1020
1021							It is a hash, and the keys are lowercase tag names.
1022
1023							The values in the hash are hashrefs. The keys in these subhashes are
1024							lowercase attribute names, and the values are attribute value class names,
1025							which are short strings describing the type of values that the
1026							attribute can take, such as C or C.
1027
1028							=cut
1029
1030	10			10		64	use vars qw(%_Attrib);
	10					18
	10					6646
1031
1032							BEGIN {
1033
1034	10			10		47	my %attr = ( 'style' => 'style' );
1035
1036	10					60	my %font_attr = ( %attr,
1037							'size' => 'size',
1038							'face' => 'wordlist',
1039							'color' => 'color',
1040							);
1041
1042	10					46	my %insdel_attr = ( %attr,
1043							'cite' => 'href',
1044							'datetime' => 'text',
1045							);
1046
1047	10					661	my %texta_attr = ( %attr, 'align' => 'word', );
1048
1049	10					40	my %cellha_attr = ( 'align' => 'word',
1050							'char' => 'word',
1051							'charoff' => 'size',
1052							);
1053
1054	10					27	my %cellva_attr = ( 'valign' => 'word', );
1055
1056	10					183	my %cellhv_attr = ( %attr, %cellha_attr, %cellva_attr );
1057
1058	10					65	my %col_attr = ( %attr, %cellhv_attr,
1059							'width' => 'size',
1060							'span' => 'number',
1061							);
1062
1063	10					198	my %thtd_attr = ( %attr,
1064							'abbr' => 'text',
1065							'axis' => 'text',
1066							'headers' => 'text',
1067							'scope' => 'word',
1068							'rowspan' => 'number',
1069							'colspan' => 'number',
1070							%cellhv_attr,
1071							'nowrap' => 'novalue',
1072							'bgcolor' => 'color',
1073							'width' => 'size',
1074							'height' => 'size',
1075							'bordercolor' => 'color',
1076							'bordercolorlight' => 'color',
1077							'bordercolordark' => 'color',
1078							);
1079
1080	10					1706	%_Attrib = ( 'br' => { 'clear' => 'word' },
1081							'em' => \%attr,
1082							'strong' => \%attr,
1083							'dfn' => \%attr,
1084							'code' => \%attr,
1085							'samp' => \%attr,
1086							'kbd' => \%attr,
1087							'var' => \%attr,
1088							'cite' => \%attr,
1089							'abbr' => \%attr,
1090							'acronym' => \%attr,
1091							'q' => { %attr, 'cite' => 'href' },
1092							'blockquote' => { %attr, 'cite' => 'href' },
1093							'sub' => \%attr,
1094							'sup' => \%attr,
1095							'tt' => \%attr,
1096							'i' => \%attr,
1097							'b' => \%attr,
1098							'big' => \%attr,
1099							'small' => \%attr,
1100							'u' => \%attr,
1101							's' => \%attr,
1102							'strike' => \%attr,
1103							'font' => \%font_attr,
1104							'table' => {
1105							%attr,
1106							'frame' => 'word',
1107							'rules' => 'word',
1108							%texta_attr,
1109							'bgcolor' => 'color',
1110							'background' => 'src',
1111							'width' => 'size',
1112							'height' => 'size',
1113							'cellspacing' => 'size',
1114							'cellpadding' => 'size',
1115							'border' => 'size',
1116							'bordercolor' => 'color',
1117							'bordercolorlight' => 'color',
1118							'bordercolordark' => 'color',
1119							'summary' => 'text',
1120							},
1121							'caption' => { %attr, 'align' => 'word', },
1122							'colgroup' => \%col_attr,
1123							'col' => \%col_attr,
1124							'thead' => \%cellhv_attr,
1125							'tfoot' => \%cellhv_attr,
1126							'tbody' => \%cellhv_attr,
1127							'tr' => {
1128							%attr,
1129							bgcolor => 'color',
1130							%cellhv_attr,
1131							},
1132							'th' => \%thtd_attr,
1133							'td' => \%thtd_attr,
1134							'ins' => \%insdel_attr,
1135							'del' => \%insdel_attr,
1136							'a' => { %attr, href => 'href', },
1137							'h1' => \%texta_attr,
1138							'h2' => \%texta_attr,
1139							'h3' => \%texta_attr,
1140							'h4' => \%texta_attr,
1141							'h5' => \%texta_attr,
1142							'h6' => \%texta_attr,
1143							'p' => \%texta_attr,
1144							'div' => \%texta_attr,
1145							'span' => \%texta_attr,
1146							'ul' => {
1147							%attr,
1148							'type' => 'word',
1149							'compact' => 'novalue',
1150							},
1151							'ol' => { %attr,
1152							'type' => 'text',
1153							'compact' => 'novalue',
1154							'start' => 'number',
1155							},
1156							'li' => { %attr,
1157							'type' => 'text',
1158							'value' => 'number',
1159							},
1160							'dl' => { %attr, 'compact' => 'novalue' },
1161							'dt' => \%attr,
1162							'dd' => \%attr,
1163							'address' => \%attr,
1164							'hr' => {
1165							%texta_attr,
1166							'width' => 'size',
1167							'size' => 'size',
1168							'noshade' => 'novalue',
1169							},
1170							'pre' => { %attr, 'width' => 'size' },
1171							'center' => \%attr,
1172							'nobr' => {},
1173							'img' => {
1174							'src' => 'src',
1175							'alt' => 'text',
1176							'width' => 'size',
1177							'height' => 'size',
1178							'border' => 'size',
1179							'hspace' => 'size',
1180							'vspace' => 'size',
1181							'align' => 'word',
1182							},
1183							'body' => { 'bgcolor' => 'color',
1184							'background' => 'src',
1185							'link' => 'color',
1186							'vlink' => 'color',
1187							'alink' => 'color',
1188							'text' => 'color',
1189							},
1190							'head' => {},
1191							'title' => {},
1192							'html' => {},
1193							);
1194							}
1195
1196	1487			1487	1	4684	sub init_attrib_whitelist { return \%_Attrib; }
1197
1198							=item init_attval_whitelist ()
1199
1200							Returns a reference to the C whitelist, which is a hash that maps
1201							attribute value class names from the C whitelist to coderefs to
1202							subs to validate (and optionally transform) a particular attribute value.
1203
1204							The filter calls the attribute value validation subs with the
1205							following parameters:
1206
1207							=over
1208
1209							=item C
1210
1211							A reference to the filter object.
1212
1213							=item C
1214
1215							The lowercase name of the tag in which the attribute appears.
1216
1217							=item C
1218
1219							The name of the attribute.
1220
1221							=item C
1222
1223							The attribute value found in the input document, in canonical form
1224							(see L).
1225
1226							=back
1227
1228							The validation sub can return undef to indicate that the attribute
1229							should be removed from the tag, or it can return the new value for
1230							the attribute, in canonical form.
1231
1232							=cut
1233
1234	10			10		63	use vars qw(%_AttVal);
	10					15
	10					1601
1235
1236							BEGIN {
1237	10			10		823	%_AttVal = ( 'style' => \&_hss_attval_style,
1238							'size' => \&_hss_attval_size,
1239							'number' => \&_hss_attval_number,
1240							'color' => \&_hss_attval_color,
1241							'text' => \&_hss_attval_text,
1242							'word' => \&_hss_attval_word,
1243							'wordlist' => \&_hss_attval_wordlist,
1244							'wordlistq' => \&_hss_attval_wordlistq,
1245							'href' => \&_hss_attval_href,
1246							'src' => \&_hss_attval_src,
1247							'stylesrc' => \&_hss_attval_stylesrc,
1248							'novalue' => \&_hss_attval_novalue,
1249							);
1250							}
1251
1252	1487			1487	1	3882	sub init_attval_whitelist { return \%_AttVal; }
1253
1254							=item init_style_whitelist ()
1255
1256							Returns a reference to the C