package Template::Stash::AutoEscaping;
use strict;
use warnings;
our $VERSION = '0.0302';
use Template::Config;
use base ($Template::Config::STASH, 'Class::Data::Inheritable');
use Data::Dumper;
use UNIVERSAL::require;
use Template::Stash::AutoEscaping::RawString;
use Template::Exception;
__PACKAGE__->mk_classdata('class_for_type');
__PACKAGE__->class_for_type({
HTML => __PACKAGE__ . '::Escaped::HTML',
YourCode => __PACKAGE__ . '::Escaped::YourCode',
});
our $DEBUG = 0;
our $escape_count = 0;
our $ESCAPE_ARGS = 0;
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{method_for_raw} ||= 'raw';
$self->{method_for_escape} ||= 'escape';
$self->{_raw_string_class} ||= __PACKAGE__ . '::' . 'RawString';
$self->{ignore_escape} ||= [];
$self->{die_on_unescaped} ||= 0;
if (ref $self->{escape_method} eq "CODE") {
$self->{escape_type} = "YourCode";
my $escape_class = $class->class_for($self->{escape_type});
if (!$escape_class->can("escape")) {
$escape_class->require or die $@;
}
$escape_class->escape_method($self->{escape_method});
} else {
$self->{escape_type} ||= 'HTML';
my $escape_class = $class->class_for($self->{escape_type});
if (!$escape_class->can("escape")) {
$escape_class->require or die $@;
}
}
foreach my $ops ($Template::Stash::SCALAR_OPS, $Template::Stash::LIST_OPS)
{
$ops->{$self->{method_for_raw}} = sub {
my $scalar = shift;
return $self->{_raw_string_class}->new($scalar);
};
$ops->{$self->{method_for_escape}} = sub {
my $scalar = shift;
return $self->{_raw_string_class}->new(
$self->escape($scalar),
);
};
};
return $self;
}
sub get_raw_args {
my ( $args, $escaped_class ) = @_;
my $changed = 0;
my @raw_args;
for my $v (@{ $args }) {
my $new_v;
if ( ref $v eq $escaped_class ) {
$changed = 1;
$new_v = $v->[0];
} elsif (ref $v eq 'ARRAY') {
$new_v = get_raw_args($v, $escaped_class);
if ($new_v) {
$changed = 1;
} else {
$new_v = $v;
}
} else {
$new_v = $v;
}
push @raw_args, $new_v;
}
return unless $changed;
return \@raw_args;
}
sub get {
my ( $self, @args ) = @_;
# get value
warn Dumper +{ args => \@args } if $DEBUG;
# note: hack for [% hash.${key} %] [% hash.item(key) %]
# key expected raw string.
if (!$ESCAPE_ARGS && ref $args[0] eq "ARRAY" && (scalar @{$args[0]} > 2)){
my $escaped_class = $self->class_for($self->{escape_type});
my $changed = get_raw_args($args[0], $escaped_class);
# retry by non-escaped args
if ($changed) {
$args[0] = $changed;
return $self->get(@args);
}
}
my ($var) = $self->SUPER::get(@args);
if (ref $args[0] eq "ARRAY") {
my $key = $args[0]->[0];
warn $key if $DEBUG;
if (grep { $key eq $_ } @{ $self->{ignore_escape} }) {
warn "ignore escape $key" if $DEBUG;
return $var;
}
}
my $ref = ref $var;
# string
if ((!$ref) and (length($var) > 0)) {
if ($self->{die_on_unescaped}) {
die Template::Exception->new(
Dumper([ $args[0] ]), "Unescaped and not marked as raw"
);
}
else {
$escape_count++ if $DEBUG;
return $self->escape($var);
}
}
# via .raw vmethod
if ($ref eq $self->{_raw_string_class}) {
return "$var";
}
return $var;
# my $escape_class = $self->class_for($self->{escape_type});
# warn $ref->isa($escape_class);
# if (!$ref->isa($escape_class)) {
# $escape_count++ if $DEBUG;
# return $self->escape($var);
# }
# return $var;
}
sub class_for {
my $class = shift;
if (@_ == 1) {
return $class->class_for_type->{$_[0]} || __PACKAGE__ . '::Escaped::' . $_[0];
} elsif (@_ == 2) {
return $class->class_for_type->{$_[0]} = $_[1];
}
}
sub escape {
my $self = shift;
my $text = shift;
my $class = $self->class_for($self->{escape_type});
my $stringify_callback = $self->{before_stringify};
$class->new($text, 0, undef, $stringify_callback);
}
sub escape_count {
$escape_count;
}
1;
__END__
=encoding utf8
=head1 NAME
Template::Stash::AutoEscaping - escape automatically in Template-Toolkit.
=head1 SYNOPSIS
use Template;
use Template::Stash::AutoEscaping;
my $tt = Template->new({
STASH => Template::Stash::AutoEscaping->new
});
=head1 METHODS
=head2 new
=over 4
=item die_on_unescaped
This value, if set to a true value, causes the process to throw an exception
upon encountering a value that was not explicitly set to be escaped or was
marked as a raw value.
=item escape_type
default is HTML
=item method_for_escape
The default method to escape a value explicitly (mostly useful with
C<die_on_unescaped> .
=item method_for_raw
default is raw, you can get not escaped value from [% value.raw %]
=item escape_method
my $tt = Template->new({
STASH => Template::Stash::AutoEscaping->new({
escape_method => sub { my $text = shift; ... ; return $text }
})
});
=item ignore_escape
my $stash = Template::Stash::AutoEscaping->new({ignore_escape => [qw(include_html include_raw my_escape_func)], ... );
You can disable auto-escape for some value or TT-Macro.
For example: include other component, for output safety html, using other escape method, etc.
=back
=head2 class_for
Template::Stash::AutoEscaping->class_for("HTML") # Template::Stash::AutoEscaping::Escaped::HTML
Template::Stash::AutoEscaping->class_for("HTML" => "MyHTMLString");
=head2 escape
B<For internal use>.
=head2 escape_count
B<For internal use>.
=head2 get
B<For internal use>.
=head2 get_raw_args
B<For internal use>.
=head1 DESCRIPTION
Template::Stash::AutoEscaping is a sub class of L<Template::Stash>, automatically escape all HTML strings and avoid XSS vulnerability.
=head1 CONFIGURE
=over 4
=item $Template::Stash::AutoEscaping::ESCAPE_ARGS
default is 0. for example "key of hash" or "args of vmethods" are not escaped. I think this is good in most cases.
[% hash.${key} %] [% hash.item(key) %] means [% hash.${key.raw} | html %] [% hash.item(key.raw) | html %] by default.
=back
=head1 AUTHOR
mala E<lt>cpan@ma.laE<gt> (original author of L<Template::Stash::AutoEscape>)
Shlomi Fish (L<http://www.shlomifish.org/>) added some enhancements and
fixes, while disclaiming all rights, as part of his work for
L<http://reask.com/> and released the result as
C<Template::Stash::AutoEscaping> .
=head1 SEE ALSO
L<Template>, L<Template::Stash::EscapedHTML>, L<Template::Stash::AutoEscape>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut