Sorry for the OT ness of this thread---
I spent the better part of the past 2 days trying to do a 1pass
content filtering on xss attacks-- including flash. breaking down
every piece of user input 2x wasn't nice on my server load.
I liked HTML::TagFilter, but it was making broken tags and I couldn't
push the new tag defaults into it.
So thanks to Clinton Gormley for helping me decide on
HTML::StripScripts::Parser -- which does facilitate tag defaults--
albeit in an awkward manner.
Clinton also made a nice skeleton of a wrapper for me to get a
feeling for, saving me a large bit of the learning curve.
In any event, what follows is code that will rewrite user input of
'embed' tags for flash and replace in allowScriptAccess='never' and
allowNetworking='internal' (object tags are not whitelisted for this )
if you let people embed flash onto your site, you will probably want
to read the code below.
==========
use strict;
use warnings;
package Wrapper::StripScriptsParser;
use base 'HTML::StripScripts::Parser';
use HTML::Entities();
sub new {
my $proto = shift;
my $self = $proto->SUPER::new({
Context=> 'Flow',
AllowHref=> 1,
AllowSrc=> 1,
});
$self->attr_encoded(0);
return $self;
}
#override the context whitelist, and stick embed in there. we'll
allow it.
sub init_context_whitelist {
my ( $self )= @_;
my $context_whitelist= $self->SUPER::init_context_whitelist() ;
$context_whitelist->{'Flow'}{'embed'}= 'Inline';
$context_whitelist->{'Context'}{'embed'}= 'Inline';
return $context_whitelist;
}
#override the attribute whitelist, and add custom cases for embed tags
sub init_attrib_whitelist {
my ( $self )= @_;
my $attrib_whitelist= $self->SUPER::init_attrib_whitelist() ;
$attrib_whitelist->{'embed'}= {
src=> 'href',
type=>'word',
width=>'number',
height=>'number',
flashvars=>'text',
allowscriptaccess=>'allowscriptaccess',
allownetworking=>'allownetworking'
};
return $attrib_whitelist
}
#override the attribute value whitelist, and add custom classes for
allowscriptaccess and allownetworking
sub init_attval_whitelist {
my ( $self )= @_;
my $attval_whitelist= $self->SUPER::init_attval_whitelist() ;
$attval_whitelist->{'allowscriptaccess'}=
\&attval_allowscriptaccess;
$attval_whitelist->{'allownetworking'}=
\&attval_allownetworking;
return $attval_whitelist;
}
#custom attribute value class. cleans up flash embeds
sub attval_allowscriptaccess {
my ($filter, $tagname, $attrname, $attrval) = @_;
if ( $tagname eq 'embed' ) {
return 'never';
};
return undef;
}
#custom attribute value class. cleans up flash embeds
sub attval_allownetworking {
my ($filter, $tagname, $attrname, $attrval) = @_;
if ( $tagname eq 'embed' ) {
return 'internal';
};
return undef;
}
sub filter {
my ( $self , $text )= @_;
$self->parse($text);
$self->eof;
return $self->filtered_document;
}
sub reject_start {
$_[0]->output(HTML::Entities::encode($_[1]));
}
sub reject_end {
$_[0]->output(HTML::Entities::encode($_[1]));
}
sub reject_text {
$_[0]->output(HTML::Entities::encode($_[1]));
}
sub reject_declaration {}
sub reject_comment {}
sub reject_process {}
sub __dump__ {
my ( $self )= @_;
use Data::Dumper();
print STDERR Data::Dumper->Dump( [$self] , [qw(self)] );
}
###############################################################
package main;
sub defang_text_ {
my ( $text )= @_;
my $hss= Wrapper::StripScriptsParser->new();
return $hss->filter($text);
}
my $kill= <<EOF;
<b>HI</b>
A
<i>Hello</i>
<a href="http://a.com"; > hi</a>
<embed flashvars="a=f" allowscriptaccess="a"
allowNetworking="internal" type="application/x-shockwave-flash"
src="http://a.com/a.swf";></embed>
A1
<embed flashvars="b=asd" allowScriptAccess="never"
allowNetworking="internal" type="application/x-shockwave-flash"
src="http://a.com/a.swf";></embed>
B
<embed flashvars="c=kajsdlk@" allowScriptAccess="always"
allowNetworking="sameDomain" type="application/x-shockwave-flash"
src="http://b.com/b.swf"; />
C
<span />
D
<div />
EOF
print defang_text_( $kill );
###############################################################
1;
