62 lines
1.4 KiB
Perl
62 lines
1.4 KiB
Perl
package WhiteListSanitizer;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use HTML::Scrubber;
|
|
|
|
our @default_allowed_tags = qw(strong em b i p code pre tt samp kbd var sub
|
|
sup dfn cite big small address hr br div span h1 h2 h3 h4 h5 h6 ul ol
|
|
li dl dt dd abbr acronym a img blockquote del ins);
|
|
|
|
our @default_allowed_attributes = qw(href src width height alt cite datetime
|
|
title class name xml:lang abbr);
|
|
|
|
sub new {
|
|
my ($class, @args) = @_;
|
|
my $self = bless {}, $class;
|
|
return $self->_init(@args);
|
|
}
|
|
|
|
sub _init {
|
|
my ($self) = @_;
|
|
return $self;
|
|
}
|
|
|
|
sub _scrubber {
|
|
my $self = shift;
|
|
return $self->{_scrubber} //= HTML::Scrubber->new;
|
|
}
|
|
|
|
sub _allowed_tags {
|
|
my ($self, $options) = shift;
|
|
$options->{tags} || [@default_allowed_tags];
|
|
}
|
|
|
|
sub _allowed_attributes {
|
|
my ($self, $options) = shift;
|
|
$options->{attributes} || [@default_allowed_attributes];
|
|
}
|
|
|
|
sub _configure_scrubber {
|
|
my ($self, $options) = @_;
|
|
|
|
$self->_scrubber->allow(map {$_ => 1} @{$self->_allowed_tags($options)});
|
|
$self->_scrubber->default(
|
|
0 => { # default rule, deny all tags
|
|
'*' => 0, # default rule, deny all attributes
|
|
map { $_ => 1 } @{$self->_allowed_attributes($options)}
|
|
}
|
|
);
|
|
}
|
|
|
|
sub sanitize {
|
|
my ($self, $html, %options) = @_;
|
|
|
|
return unless defined $html;
|
|
return $html if $html eq "";
|
|
|
|
$self->_configure_scrubber(\%options);
|
|
return $self->_scrubber->scrub($html);
|
|
}
|
|
|
|
1;
|