cleanhtml.pl

Revision 14115, 53.4 kB (checked in by sup, 2 weeks ago)
LJSUP-2572: Make HTML cleaning of the comments more stronger
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`

Line
1	#!/usr/bin/perl
2
3	use strict;
4	use Class::Autouse qw(
5	URI
6	HTMLCleaner
7	LJ::CSS::Cleaner
8	HTML::TokeParser
9	LJ::EmbedModule
10	LJ::Config
11	);
12
13	LJ::Config->load;
14
15	package LJ;
16
17	# <LJFUNC>
18	# name: LJ::strip_bad_code
19	# class: security
20	# des: Removes malicious/annoying HTML.
21	# info: This is just a wrapper function around [func[LJ::CleanHTML::clean]].
22	# args: textref
23	# des-textref: Scalar reference to text to be cleaned.
24	# returns: Nothing.
25	# </LJFUNC>
26	sub strip_bad_code
27	{
28	my $data = shift;
29	LJ::CleanHTML::clean($data, {
30	'eat' => [qw[layer iframe script object embed]],
31	'mode' => 'allow',
32	'keepcomments' => 1, # Allows CSS to work
33	});
34	}
35
36	package LJ::CleanHTML;
37	# LJ::CleanHTML::clean(\$u->{'bio'}, {
38	# 'wordlength' => 100, # maximum length of an unbroken "word"
39	# 'addbreaks' => 1, # insert <br/> after newlines where appropriate
40	# 'tablecheck' => 1, # make sure they aren't closing </td> that weren't opened.
41	# 'eat' => [qw(head title style layer iframe)],
42	# 'mode' => 'allow',
43	# 'deny' => [qw(marquee)],
44	# 'remove' => [qw()],
45	# 'maximgwidth' => 100,
46	# 'maximgheight' => 100,
47	# 'keepcomments' => 1,
48	# 'cuturl' => 'http://www.domain.com/full_item_view.ext',
49	# 'ljcut_disable' => 1, # stops the cleaner from using the lj-cut tag
50	# 'cleancss' => 1,
51	# 'extractlinks' => 1, # remove a hrefs; implies noautolinks
52	# 'noautolinks' => 1, # do not auto linkify
53	# 'extractimages' => 1, # placeholder images
54	# 'transform_embed_nocheck' => 1, # do not do checks on object/embed tag transforming
55	# 'transform_embed_wmode' => <value>, # define a wmode value for videos (usually 'transparent' is the value you want)
56	# 'blocked_links' => [ qr/evil\.com/, qw/spammer\.com/ ], # list of sites which URL's will be blocked
57	# 'blocked_link_substitute' => 'http://domain.com/error.html' # blocked links will be replaced by this URL
58	# });
59
60	sub helper_preload
61	{
62	my $p = HTML::TokeParser->new("");
63	eval {$p->DESTROY(); };
64	}
65
66
67	# this treats normal characters and &entities; as single characters
68	# also treats UTF-8 chars as single characters if $LJ::UNICODE
69	my $onechar;
70	{
71	my $utf_longchar = '[\xc2-\xdf][\x80-\xbf]\|\xe0[\xa0-\xbf][\x80-\xbf]\|[\xe1-\xef][\x80-\xbf][\x80-\xbf]\|\xf0[\x90-\xbf][\x80-\xbf][\x80-\xbf]\|[\xf1-\xf7][\x80-\xbf][\x80-\xbf][\x80-\xbf]';
72	my $match;
73	if (not $LJ::UNICODE) {
74	$match = '[^&\s]\|(&\#?\w{1,7};)';
75	} else {
76	$match = $utf_longchar . '\|[^&\s\x80-\xff]\|(?:&\#?\w{1,7};)';
77	}
78	$onechar = qr/$match/o;
79	}
80
81	# Some browsers, such as Internet Explorer, have decided to alllow
82	# certain HTML tags to be an alias of another. This has manifested
83	# itself into a problem, as these aliases act in the browser in the
84	# same manner as the original tag, but are not treated the same by
85	# the HTML cleaner.
86	# 'alias' => 'real'
87	my %tag_substitute = (
88	'image' => 'img',
89	);
90
91	# In XHTML you can close a tag in the same opening tag like <br />,
92	# but some browsers still will interpret it as an opening only tag.
93	# This is a list of tags which you can actually close with a trailing
94	# slash and get the proper behavior from a browser.
95	my $slashclose_tags = qr/^(?:area\|base\|basefont\|br\|col\|embed\|frame\|hr\|img\|input\|isindex\|link\|meta\|param\|lj-embed)$/i;
96
97	# <LJFUNC>
98	# name: LJ::CleanHTML::clean
99	# class: text
100	# des: Multi-faceted HTML parse function
101	# info:
102	# args: data, opts
103	# des-data: A reference to HTML to parse to output, or HTML if modified in-place.
104	# des-opts: An hash of options to pass to the parser.
105	# returns: Nothing.
106	# </LJFUNC>
107	sub clean
108	{
109	my $data = shift;
110	my $opts = shift;
111	my $newdata;
112
113	# remove the auth portion of any see_request.bml links
114	$$data =~ s/(see_request\.bml\S+?)auth=\w+/$1/ig;
115
116	my $p = HTML::TokeParser->new($data);
117
118	my $wordlength = $opts->{'wordlength'};
119	my $addbreaks = $opts->{'addbreaks'};
120	my $keepcomments = $opts->{'keepcomments'};
121	my $mode = $opts->{'mode'};
122	my $cut = $opts->{'cuturl'} \|\| $opts->{'cutpreview'};
123	my $ljcut_disable = $opts->{'ljcut_disable'};
124	my $s1var = $opts->{'s1var'};
125	my $extractlinks = 0 \|\| $opts->{'extractlinks'};
126	my $noautolinks = $extractlinks \|\| $opts->{'noautolinks'};
127	my $noexpand_embedded = $opts->{'noexpandembedded'} \|\| $opts->{'textonly'} \|\| 0;
128	my $transform_embed_nocheck = $opts->{'transform_embed_nocheck'} \|\| 0;
129	my $transform_embed_wmode = $opts->{'transform_embed_wmode'};
130	my $remove_colors = $opts->{'remove_colors'} \|\| 0;
131	my $remove_sizes = $opts->{'remove_sizes'} \|\| 0;
132	my $remove_fonts = $opts->{'remove_fonts'} \|\| 0;
133	my $blocked_links = (exists $opts->{'blocked_links'}) ? $opts->{'blocked_links'} : \@LJ::BLOCKED_LINKS;
134	my $blocked_link_substitute =
135	(exists $opts->{'blocked_link_substitute'}) ? $opts->{'blocked_link_substitute'} :
136	($LJ::BLOCKED_LINK_SUBSTITUTE) ? $LJ::BLOCKED_LINK_SUBSTITUTE : '#';
137	my $suspend_msg = $opts->{'suspend_msg'} \|\| 0;
138	my $unsuspend_supportid = $opts->{'unsuspend_supportid'} \|\| 0;
139
140	my @canonical_urls; # extracted links
141	my %action = ();
142	my %remove = ();
143	if (ref $opts->{'eat'} eq "ARRAY") {
144	foreach (@{$opts->{'eat'}}) { $action{$_} = "eat"; }
145	}
146	if (ref $opts->{'allow'} eq "ARRAY") {
147	foreach (@{$opts->{'allow'}}) { $action{$_} = "allow"; }
148	}
149	if (ref $opts->{'deny'} eq "ARRAY") {
150	foreach (@{$opts->{'deny'}}) { $action{$_} = "deny"; }
151	}
152	if (ref $opts->{'remove'} eq "ARRAY") {
153	foreach (@{$opts->{'remove'}}) { $action{$_} = "deny"; $remove{$_} = 1; }
154	}
155
156	$action{'script'} = "eat";
157
158	# if removing sizes, remove heading tags
159	if ($remove_sizes) {
160	foreach my $tag (qw( h1 h2 h3 h4 h5 h6 )) {
161	$action{$tag} = "deny";
162	$remove{$tag} = 1;
163	}
164	}
165
166	if ($opts->{'strongcleancss'}) {
167	$opts->{'cleancss'} = 1;
168	}
169
170	my @attrstrip = qw();
171	# cleancss means clean annoying css
172	# clean_js_css means clean javascript from css
173	if ($opts->{'cleancss'}) {
174	push @attrstrip, 'id';
175	$opts->{'clean_js_css'} = 1;
176	}
177
178	if ($opts->{'nocss'}) {
179	push @attrstrip, 'style';
180	}
181
182	if (ref $opts->{'attrstrip'} eq "ARRAY") {
183	foreach (@{$opts->{'attrstrip'}}) { push @attrstrip, $_; }
184	}
185
186	my %opencount = ();
187	my @tablescope = ();
188
189	my $cutcount = 0;
190
191	# bytes known good. set this BEFORE we start parsing any new
192	# start tag, where most evil is (because where attributes can be)
193	# then, if we have to totally fail, we can cut stuff off after this.
194	my $good_until = 0;
195
196	# then, if we decide that part of an entry has invalid content, we'll
197	# escape that part and stuff it in here. this lets us finish cleaning
198	# the "good" part of the entry (since some tags might not get closed
199	# till after $good_until bytes into the text).
200	my $extra_text;
201	my $total_fail = sub {
202	my $tag = LJ::ehtml(@_);
203
204	my $edata = LJ::ehtml($$data);
205	$edata =~ s/\r?\n/<br \/>/g if $addbreaks;
206
207	$extra_text = "<div class='ljparseerror'>[<b>Error:</b> Irreparable invalid markup ('<$tag>') in entry. ".
208	"Owner must fix manually. Raw contents below.]<br /><br />" .
209	'<div style="width: 95%; overflow: auto">' . $edata . '</div></div>';
210	};
211
212	my $htmlcleaner = HTMLCleaner->new(valid_stylesheet => \&LJ::valid_stylesheet_url);
213
214	my $eating_ljuser_span = 0; # bool, if we're eating an ljuser span
215	my $ljuser_text_node = ""; # the last text node we saw while eating ljuser tags
216	my @eatuntil = (); # if non-empty, we're eating everything. thing at end is thing
217	# we're looking to open again or close again.
218
219	my $capturing_during_eat; # if we save all tokens that happen inside the eating.
220	my @capture = (); # if so, they go here
221
222	my $form_tag = {
223	input => 1,
224	select => 1,
225	option => 1,
226	};
227
228	my $start_capture = sub {
229	next if $capturing_during_eat;
230
231	my ($tag, $first_token, $cb) = @_;
232	push @eatuntil, $tag;
233	@capture = ($first_token);
234	$capturing_during_eat = $cb \|\| sub {};
235	};
236
237	my $finish_capture = sub {
238	@capture = ();
239	$capturing_during_eat = undef;
240	};
241
242	TOKEN:
243	while (my $token = $p->get_token)
244	{
245	my $type = $token->[0];
246
247	# See if this tag should be treated as an alias
248
249	$token->[1] = $tag_substitute{$token->[1]} if defined $tag_substitute{$token->[1]} &&
250	($type eq 'S' \|\| $type eq 'E');
251
252	if ($type eq "S") # start tag
253	{
254	my $tag = $token->[1];
255	my $attr = $token->[2]; # hashref
256
257	$good_until = length $newdata;
258
259	if (@eatuntil) {
260	push @capture, $token if $capturing_during_eat;
261	if ($tag eq $eatuntil[-1]) {
262	push @eatuntil, $tag;
263	}
264	next TOKEN;
265	}
266
267	if ($tag eq "lj-template" && ! $noexpand_embedded) {
268	my $name = $attr->{name} \|\| "";
269	$name =~ s/-/_/g;
270
271	my $run_template_hook = sub {
272	# can pass in tokens to override passing the hook the @capture array
273	my ($token, $override_capture) = @_;
274	my $capture = $override_capture ? [$token] : \@capture;
275	my $expanded = ($name =~ /^\w+$/) ? LJ::run_hook("expand_template_$name", $capture) : "";
276	$newdata .= $expanded \|\| "<b>[Error: unknown template '" . LJ::ehtml($name) . "']</b>";
277	};
278
279	if ($attr->{'/'}) {
280	# template is self-closing, no need to do capture
281	$run_template_hook->($token, 1);
282	} else {
283	# capture and send content to hook
284	$start_capture->("lj-template", $token, $run_template_hook);
285	}
286	next TOKEN;
287	}
288
289	if ($tag eq "lj-replace") {
290	my $name = $attr->{name} \|\| "";
291	my $replace = ($name =~ /^\w+$/) ? LJ::lj_replace($name, $attr) : undef;
292	$newdata .= defined $replace ? $replace : "<b>[Error: unknown lj-replace key '" . LJ::ehtml($name) . "']</b>";
293
294	next TOKEN;
295	}
296
297	# Capture object and embed tags to possibly transform them into something else.
298	if ($tag eq "object" \|\| $tag eq "embed") {
299	if (LJ::are_hooks("transform_embed") && !$noexpand_embedded) {
300	# XHTML style open/close tags done as a singleton shouldn't actually
301	# start a capture loop, because there won't be a close tag.
302	if ($attr->{'/'}) {
303	$newdata .= LJ::run_hook("transform_embed", [$token],
304	nocheck => $transform_embed_nocheck, wmode => $transform_embed_wmode) \|\| "";
305	next TOKEN;
306	}
307
308	$start_capture->($tag, $token, sub {
309	my $expanded = LJ::run_hook("transform_embed", \@capture,
310	nocheck => $transform_embed_nocheck, wmode => $transform_embed_wmode);
311	$newdata .= $expanded \|\| "";
312	});
313	next TOKEN;
314	}
315	}
316
317	if ($tag eq "span" && lc $attr->{class} eq "ljuser" && ! $noexpand_embedded) {
318	$eating_ljuser_span = 1;
319	$ljuser_text_node = "";
320	}
321
322	if ($eating_ljuser_span) {
323	next TOKEN;
324	}
325
326	if (($tag eq "div" \|\| $tag eq "span") && lc $attr->{class} eq "ljvideo") {
327	$start_capture->($tag, $token, sub {
328	my $expanded = LJ::run_hook("expand_template_video", \@capture);
329	$newdata .= $expanded \|\| "<b>[Error: unknown template 'video']</b>";
330	});
331	next TOKEN;
332	}
333
334	# do some quick checking to see if this is an email address/URL, and if so, just
335	# escape it and ignore it
336	if ($tag =~ m!(?:\@\|://)!) {
337	$newdata .= LJ::ehtml("<$tag>");
338	next;
339	}
340
341	if ($form_tag->{$tag}) {
342	if (! $opencount{form}) {
343	$newdata .= "<$tag ... >";
344	next;
345	}
346
347	if ($tag eq "input") {
348	if ($attr->{type} !~ /^\w+$/ \|\| lc $attr->{type} eq "password") {
349	delete $attr->{type};
350	}
351	}
352	}
353
354	my $slashclose = 0; # If set to 1, use XML-style empty tag marker
355	# for tags like <name/>, pretend it's <name> and reinsert the slash later
356	$slashclose = 1 if ($tag =~ s!/$!!);
357
358	unless ($tag =~ /^\w([\w\-:_]*\w)?$/) {
359	$total_fail->($tag);
360	last TOKEN;
361	}
362
363	# for incorrect tags like <name/attrib=val> (note the lack of a space)
364	# delete everything after 'name' to prevent a security loophole which happens
365	# because IE understands them.
366	$tag =~ s!/.+$!!;
367
368	if ($action{$tag} eq "eat") {
369	$p->unget_token($token);
370	$p->get_tag("/$tag");
371	next;
372	}
373
374	# try to call HTMLCleaner's element-specific cleaner on this open tag
375	my $clean_res = eval {
376	my $cleantag = $tag;
377	$cleantag =~ s/^.*://s;
378	$cleantag =~ s/[^\w]//g;
379	no strict 'subs';
380	my $meth = "CLEAN_$cleantag";
381	my $seq = $token->[3]; # attribute names, listref
382	my $code = $htmlcleaner->can($meth)
383	or return 1;
384	return $code->($htmlcleaner, $seq, $attr);
385	};
386	next if !$@ && !$clean_res;
387
388	# this is so the rte converts its source to the standard ljuser html
389	my $ljuser_div = $tag eq "div" && $attr->{class} eq "ljuser";
390	if ($ljuser_div) {
391	my $ljuser_text = $p->get_text("/b");
392	$p->get_tag("/div");
393	$ljuser_text =~ s/\[info\]//;
394	$tag = "lj";
395	$attr->{'user'} = $ljuser_text;
396	}
397	# stupid hack to remove the class='ljcut' from divs when we're
398	# disabling them, so we account for the open div normally later.
399	my $ljcut_div = $tag eq "div" && lc $attr->{class} eq "ljcut";
400	if ($ljcut_div && $ljcut_disable) {
401	$ljcut_div = 0;
402	}
403
404	# no cut URL, record the anchor, but then fall through
405	if (0 && $ljcut_div && !$cut) {
406	$cutcount++;
407	$newdata .= "<a name=\"cutid$cutcount\"></a>";
408	$ljcut_div = 0;
409	}
410
411	if (($tag eq "lj-cut" \|\| $ljcut_div)) {
412	next TOKEN if $ljcut_disable;
413	$cutcount++;
414	my $link_text = sub {
415	my $text = "Read more...";
416	if ($attr->{'text'}) {
417	$text = $attr->{'text'};
418	if ($text =~ /[^\x01-\x7f]/) {
419	$text = pack('C', unpack('C', $text));
420	}
421	$text =~ s/</</g;
422	$text =~ s/>/>/g;
423	}
424	return $text;
425	};
426	if ($cut) {
427	my $etext = $link_text->();
428	my $url = LJ::ehtml($cut);
429	$newdata .= "<div>" if $tag eq "div";
430	$newdata .= "<b>( <a href=\"$url#cutid$cutcount\">$etext</a> )</b>";
431	$newdata .= "</div>" if $tag eq "div";
432	unless ($opts->{'cutpreview'}) {
433	push @eatuntil, $tag;
434	next TOKEN;
435	}
436	} else {
437	$newdata .= "<a name=\"cutid$cutcount\"></a>" unless $opts->{'textonly'};
438	if ($tag eq "div" && !$opts->{'textonly'}) {
439	$opencount{"div"}++;
440	my $etext = $link_text->();
441	$newdata .= "<div class=\"ljcut\" text=\"$etext\">";
442	}
443	next;
444	}
445	}
446	elsif ($tag eq "style") {
447	my $style = $p->get_text("/style");
448	$p->get_tag("/style");
449	unless ($LJ::DISABLED{'css_cleaner'}) {
450	my $cleaner = LJ::CSS::Cleaner->new;
451	$style = $cleaner->clean($style);
452	LJ::run_hook('css_cleaner_transform', \$style);
453	if ($LJ::IS_DEV_SERVER) {
454	$style = "/* cleaned */\n" . $style;
455	}
456	}
457	$newdata .= "\n<style>\n$style</style>\n";
458	next;
459	}
460	elsif ($tag eq "lj")
461	{
462	# keep <lj comm> working for backwards compatibility, but pretend
463	# it was <lj user> so we don't have to account for it below.
464	my $user = $attr->{'user'} = exists $attr->{'user'} ? $attr->{'user'} :
465	exists $attr->{'comm'} ? $attr->{'comm'} : undef;
466
467	if (length $user) {
468	my $orig_user = $user; # save for later, in case
469	$user = LJ::canonical_username($user);
470	if ($s1var) {
471	$newdata .= "%%ljuser:$1%%" if $attr->{'user'} =~ /^\%\%([\w\-\']+)\%\%$/;
472	} elsif (length $user) {
473	if ($opts->{'textonly'}) {
474	$newdata .= $user;
475	} else {
476	$newdata .= LJ::ljuser($user);
477	}
478	} else {
479	$orig_user = LJ::no_utf8_flag($orig_user);
480	$newdata .= "<b>[Bad username: " . LJ::ehtml($orig_user) . "]</b>";
481	}
482	} else {
483	$newdata .= "<b>[Unknown LJ tag]</b>";
484	}
485	}
486	elsif ($tag eq "lj-raw")
487	{
488	# Strip it out, but still register it as being open
489	$opencount{$tag}++;
490	}
491
492	# Don't allow any tag with the "set" attribute
493	elsif ($tag =~ m/:set$/) {
494	next;
495	}
496	else
497	{
498	my $alt_output = 0;
499
500	my $hash = $token->[2];
501	my $attrs = $token->[3]; # attribute names, in original order
502
503	$slashclose = 1 if delete $hash->{'/'};
504
505	foreach (@attrstrip) {
506	# maybe there's a better place for this?
507	next if (lc $tag eq 'lj-embed' && lc $_ eq 'id');
508	delete $hash->{$_};
509	}
510
511	if ($tag eq "form") {
512	my $action = lc($hash->{'action'});
513	my $deny = 0;
514	if ($action =~ m!^https?://?([^/]+)!) {
515	my $host = $1;
516	$deny = 1 if
517	$host =~ /[%\@\s]/ \|\|
518	$LJ::FORM_DOMAIN_BANNED{$host};
519	} else {
520	$deny = 1;
521	}
522	delete $hash->{'action'} if $deny;
523	}
524
525	ATTR:
526	foreach my $attr (keys %$hash)
527	{
528	if ($attr =~ /^(?:on\|dynsrc)/) {
529	delete $hash->{$attr};
530	next;
531	}
532
533	if ($attr eq "data") {
534	delete $hash->{$attr} unless $tag eq "object";
535	next;
536	}
537
538	if ($attr eq "href" && $hash->{$attr} =~ /^data/) {
539	delete $hash->{$attr};
540	next;
541	}
542
543	if ($attr =~ /(?:^=)\|[\x0b\x0d]/) {
544	# Cleaner attack: <p ='>' onmouseover="javascript:alert(document/**/.cookie)" >
545	# is returned by HTML::Parser as P_tag("='" => "='") Text( onmouseover...)
546	# which leads to reconstruction of valid HTML. Clever!
547	# detect this, and fail.
548	$total_fail->("$tag $attr");
549	last TOKEN;
550	}
551
552	# ignore attributes that do not fit this strict scheme
553	unless ($attr =~ /^[\w_:-]+$/) {
554	$total_fail->("$tag " . (%$hash > 1 ? "[...] " : "") . "$attr");
555	last TOKEN;
556	}
557
558	$hash->{$attr} =~ s/[\t\n]//g;
559
560	# IE ignores the null character, so strip it out
561	$hash->{$attr} =~ s/\x0//g;
562
563	# IE sucks:
564	my $nowhite = $hash->{$attr};
565	$nowhite =~ s/[\s\x0b]+//g;
566	if ($nowhite =~ /(?:jscript\|livescript\|javascript\|vbscript\|about):/ix) {
567	delete $hash->{$attr};
568	next;
569	}
570
571	if ($attr eq 'style') {
572	if ($opts->{'cleancss'}) {
573	# css2 spec, section 4.1.3
574	# position === p\osition :(
575	# strip all slashes no matter what.
576	$hash->{style} =~ s/\\//g;
577
578	# and catch the obvious ones ("[" is for things like document["coo"+"kie"]
579	foreach my $css ("/*", "[", qw(absolute fixed expression eval behavior cookie document window javascript -moz-binding)) {
580	if ($hash->{style} =~ /\Q$css\E/i) {
581	delete $hash->{style};
582	next ATTR;
583	}
584	}
585
586	if ($opts->{'strongcleancss'}) {
587	foreach my $css (qw(-moz- absolute relative outline z-index top left right bottom filter -webkit-)) {
588	if ($hash->{style} =~ /\Q$css\E/i) {
589	delete $hash->{style};
590	next ATTR;
591	}
592	}
593	}
594
595	# remove specific CSS definitions
596	if ($remove_colors) {
597	$hash->{style} =~ s/(?:background-)?color:.*?(?:;\|$)//gi;
598	}
599	if ($remove_sizes) {
600	$hash->{style} =~ s/font-size:.*?(?:;\|$)//gi;
601	}
602	if ($remove_fonts) {
603	$hash->{style} =~ s/font-family:.*?(?:;\|$)//gi;
604	}
605	}
606
607	if ($opts->{'clean_js_css'} && ! $LJ::DISABLED{'css_cleaner'}) {
608	# and then run it through a harder CSS cleaner that does a full parse
609	my $css = LJ::CSS::Cleaner->new;
610	$hash->{style} = $css->clean_property($hash->{style});
611	}
612	}
613
614	# reserve ljs_* ids for divs, etc so users can't override them to replace content
615	if ($attr eq 'id' && $hash->{$attr} =~ /^ljs_/i) {
616	delete $hash->{$attr};
617	next;
618	}
619
620	if ($s1var) {
621	if ($attr =~ /%%/) {
622	delete $hash->{$attr};
623	next ATTR;
624	}
625
626	my $props = $LJ::S1::PROPS->{$s1var};
627
628	if ($hash->{$attr} =~ /^%%([\w:]+:)?(\S+?)%%$/ && $props->{$2} =~ /[aud]/) {
629	# don't change it.
630	} elsif ($hash->{$attr} =~ /^%%cons:\w+%%[^\%]*$/) {
631	# a site constant with something appended is also fine.
632	} elsif ($hash->{$attr} =~ /%%/) {
633	my $clean_var = sub {
634	my ($mods, $prop) = @_;
635	# HTML escape and kill line breaks
636	$mods = "attr:$mods" unless
637	$mods =~ /^(color\|cons\|siteroot\|sitename\|img):/ \|\|
638	$props->{$prop} =~ /[ud]/;
639	return '%%' . $mods . $prop . '%%';
640	};
641
642	$hash->{$attr} =~ s/[\n\r]//g;
643	$hash->{$attr} =~ s/%%([\w:]+:)?(\S+?)%%/$clean_var->(lc($1), $2)/eg;
644
645	if ($attr =~ /^(href\|src\|lowsrc\|style)$/) {
646	$hash->{$attr} = "\%\%[attr[$hash->{$attr}]]\%\%";
647	}
648	}
649
650	}
651
652	# remove specific attributes
653	if (($remove_colors && ($attr eq "color" \|\| $attr eq "bgcolor" \|\| $attr eq "fgcolor" \|\| $attr eq "text")) \|\|
654	($remove_sizes && $attr eq "size") \|\|
655	($remove_fonts && $attr eq "face")) {
656	delete $hash->{$attr};
657	next ATTR;
658	}
659	}
660	if (exists $hash->{href}) {
661	## links to some resources will be completely blocked
662	## and replaced by value of 'blocked_link_substitute' param
663	if ($blocked_links) {
664	foreach my $re (@$blocked_links) {
665	if ($hash->{href} =~ $re) {
666	$hash->{href} = sprintf($blocked_link_substitute, LJ::eurl($hash->{href}));
667	last;
668	}
669	}
670	}
671
672	unless ($hash->{href} =~ s/^lj:(?:\/\/)?(.*)$/ExpandLJURL($1)/ei) {
673	$hash->{href} = canonical_url($hash->{href}, 1);
674	}
675	}
676
677	if ($tag eq "img")
678	{
679	my $img_bad = 0;
680	if (defined $opts->{'maximgwidth'} &&
681	(! defined $hash->{'width'} \|\|
682	$hash->{'width'} > $opts->{'maximgwidth'})) { $img_bad = 1; }
683	if (defined $opts->{'maximgheight'} &&
684	(! defined $hash->{'height'} \|\|
685	$hash->{'height'} > $opts->{'maximgheight'})) { $img_bad = 1; }
686	if ($opts->{'extractimages'}) { $img_bad = 1; }
687
688	$hash->{src} = canonical_url($hash->{src}, 1);
689
690	if ($img_bad) {
691	$newdata .= "<a class=\"ljimgplaceholder\" href=\"" .
692	LJ::ehtml($hash->{'src'}) . "\">" .
693	LJ::img('placeholder') . '</a>';
694	$alt_output = 1;
695	$opencount{"img"}++;
696	}
697	}
698
699	if ($tag eq "a" && $extractlinks)
700	{
701	push @canonical_urls, canonical_url($token->[2]->{href}, 1);
702	$newdata .= "<b>";
703	next;
704	}
705
706	# Through the xsl namespace in XML, it is possible to embed scripting lanaguages
707	# as elements which will then be executed by the browser. Combining this with
708	# customview.cgi makes it very easy for someone to replace their entire journal
709	# in S1 with a page that embeds scripting as well. An example being an AJAX
710	# six degrees tool, while cool it should not be allowed.
711	#
712	# Example syntax:
713	# <xsl:element name="script">
714	# <xsl:attribute name="type">text/javascript</xsl:attribute>
715	if ($tag eq 'xsl:attribute')
716	{
717	$alt_output = 1; # We'll always deal with output for this token
718
719	my $orig_value = $p->get_text; # Get the value of this element
720	my $value = $orig_value; # Make a copy if this turns out to be alright
721	$value =~ s/\s+//g; # Remove any whitespace
722
723	# See if they are trying to output scripting, if so eat the xsl:attribute
724	# container and its value
725	if ($value =~ /(javascript\|vbscript)/i) {
726
727	# Remove the closing tag from the tree
728	$p->get_token;
729
730	# Remove the value itself from the tree
731	$p->get_text;
732
733	# No harm, no foul...Write back out the original
734	} else {
735	$newdata .= "$token->[4]$orig_value";
736	}
737	}
738
739	unless ($alt_output)
740	{
741	my $allow;
742	if ($mode eq "allow") {
743	$allow = 1;
744	if ($action{$tag} eq "deny") { $allow = 0; }
745	} else {
746	$allow = 0;
747	if ($action{$tag} eq "allow") { $allow = 1; }
748	}
749
750	if ($allow && ! $remove{$tag})
751	{
752	if ($opts->{'tablecheck'}) {
753
754	$allow = 0 if
755
756	# can't open table elements from outside a table
757	($tag =~ /^(?:tbody\|thead\|tfoot\|tr\|td\|th\|caption\|colgroup\|col)$/ && ! @tablescope) \|\|
758
759	# can't open td or th if not inside tr
760	($tag =~ /^(?:td\|th)$/ && ! $tablescope[-1]->{'tr'}) \|\|
761
762	# can't open a table unless inside a td or th
763	($tag eq 'table' && @tablescope && ! grep { $tablescope[-1]->{$_} } qw(td th));
764	}
765
766	if ($allow) { $newdata .= "<$tag"; }
767	else { $newdata .= "<$tag"; }
768
769	# output attributes in original order, but only those
770	# that are allowed (by still being in %$hash after cleaning)
771	foreach (@$attrs) {
772	unless (LJ::is_ascii($hash->{$_})) {
773	# FIXME: this is so ghetto. make faster. make generic.
774	# HTML::Parser decodes entities for us (which is good)
775	# but in Perl 5.8 also includes the "poison" SvUTF8
776	# flag on the scalar it returns, thus poisoning the
777	# rest of the content this scalar is appended with.
778	# we need to remove that poison at this point. sigh
779	$hash->{$_} = LJ::no_utf8_flag($hash->{$_});
780	}
781	$newdata .= " $_=\"" . LJ::ehtml($hash->{$_}) . "\""
782	if exists $hash->{$_};
783	}
784
785	# ignore the effects of slashclose unless we're dealing with a tag that can
786	# actually close itself. Otherwise, a tag like <em /> can pass through as valid
787	# even though some browsers just render it as an opening tag
788	if ($slashclose && $tag =~ $slashclose_tags) {
789	$newdata .= " /";
790	$opencount{$tag}--;
791	$tablescope[-1]->{$tag}-- if $opts->{'tablecheck'} && @tablescope;
792	}
793	if ($allow) {
794	$newdata .= ">";
795	$opencount{$tag}++;
796
797	# maintain current table scope
798	if ($opts->{'tablecheck'}) {
799
800	# open table
801	if ($tag eq 'table') {
802	push @tablescope, {};
803
804	# new tag within current table
805	} elsif (@tablescope) {
806	$tablescope[-1]->{$tag}++;
807	}
808	}
809
810	}
811	else { $newdata .= ">"; }
812	}
813	}
814	}
815	}
816	# end tag
817	elsif ($type eq "E")
818	{
819	my $tag = $token->[1];
820	next TOKEN if $tag =~ /[^\w\-:]/;
821
822	if (@eatuntil) {
823	push @capture, $token if $capturing_during_eat;
824
825	if ($eatuntil[-1] eq $tag) {
826	pop @eatuntil;
827	if (my $cb = $capturing_during_eat) {
828	$cb->();
829	$finish_capture->();
830	}
831	next TOKEN;
832	}
833
834	next TOKEN if @eatuntil;
835	}
836
837	if ($eating_ljuser_span && $tag eq "span") {
838	$eating_ljuser_span = 0;
839	$newdata .= $opts->{'textonly'} ? $ljuser_text_node : LJ::ljuser($ljuser_text_node);
840	next TOKEN;
841	}
842
843	my $allow;
844	if ($tag eq "lj-raw") {
845	$opencount{$tag}--;
846	$tablescope[-1]->{$tag}-- if $opts->{'tablecheck'} && @tablescope;
847	}
848	elsif ($tag eq "lj-cut") {
849	if ($opts->{'cutpreview'}) {
850	$newdata .= "<b></lj-cut></b>";
851	}
852	} else {
853	if ($mode eq "allow") {
854	$allow = 1;
855	if ($action{$tag} eq "deny") { $allow = 0; }
856	} else {
857	$allow = 0;
858	if ($action{$tag} eq "allow") { $allow = 1; }
859	}
860
861	if ($extractlinks && $tag eq "a") {
862	if (@canonical_urls) {
863	my $url = LJ::ehtml(pop @canonical_urls);
864	$newdata .= "</b> ($url)";
865	next;
866	}
867	}
868
869	if ($allow && ! $remove{$tag})
870	{
871
872	if ($opts->{'tablecheck'}) {
873
874	$allow = 0 if
875
876	# can't close table elements from outside a table
877	($tag =~ /^(?:table\|tbody\|thead\|tfoot\|tr\|td\|th\|caption\|colgroup\|col)$/ && ! @tablescope) \|\|
878
879	# can't close td or th unless open tr
880	($tag =~ /^(?:td\|th)$/ && ! $tablescope[-1]->{'tr'});
881	}
882
883	if ($allow && ! ($opts->{'noearlyclose'} && ! $opencount{$tag})) {
884
885	# maintain current table scope
886	if ($opts->{'tablecheck'}) {
887
888	# open table
889	if ($tag eq 'table') {
890	pop @tablescope;
891
892	# closing tag within current table
893	} elsif (@tablescope) {
894	$tablescope[-1]->{$tag}--;
895	}
896	}
897
898	$newdata .= "</$tag>";
899	$opencount{$tag}--;
900	} else {
901	$newdata .= "</$tag>";
902	}
903	&n