CGI-Application-Plugin-ProtectCSRF-1.01/0000775000076400007640000000000010737432612016607 5ustar adminadminCGI-Application-Plugin-ProtectCSRF-1.01/README0000444000076400007640000001200710737432612017463 0ustar adminadminNAME CGI::Application::Plugin::ProtectCSRF - Plug-in protected from CSRF VERSION 1.01 SYNPSIS use Your::App; use base qw(CGI::Application); use CGI::Application::Plugin::Session; # require!! use CGI::Application::Plugin::ProtectCSRF; sub input_form : PublishCSRFID { my $self = shift; do_something(); } sub finish : ProtectCSRF { my $self = shift; $self->clear_csrf_id; do_something(); } DESCRIPTION CGI::Application::Plugin::ProtectCSRF is C::A::P protected from CSRF. When CSRF is detected, Forbidden is returned and processing is interrupted. ACTION PublishCSRFID PublishCSRFID is action publishes CSRF ticket. CSRF ticket is published when I define it as an attribute of runmode method publishing CSRF ticket, and it is saved in session. If there is form tag in HTML to display after the processing end, as for runmode method to publish, CSRF ticket is set automatically by hidden field # publish CSRF ticket sub input_form : PublishCSRFID { my $self = shift; return < HTML } # display html source
<- insert hidden field
ProtectCSRF ProtectCSRF is action to protect from CSRF Attack. If session CSRF ticket does not accord with query CSRF ticket, application consideres it to be CSRF attack and refuse to access it. Carry out the processing that you want to perform after having carried out clear_csrf_id method when access it, and it was admitted. sub finish : ProtectCSRF { my $self = shift; $self->clear_csrf_id; # require! There is not a meaning unless I do it do_something(); # The processing that you want to perform (DB processing etc) } METHOD csrf_id Get ticket for protect CSRF Example: sub input_form : PublishCSRFID { my $self = shift; my $csrf_id = $self->csrf_id; do_something(); } protect_csrf_config Initialize ProtectCSRF Option: csrf_error_status : CSRF error status code (default: 200) csrf_error_mode : CSRF error runmode name (default: _csrf_error) csrf_error_tmpl : CSRF error display html. scalarref or filepath or filehandle (default: $CSRF_ERROR_TMPL - scalarref) csrf_error_tmpl_param : CSRF error display html parameter (for HTML::Template) csrf_id : CSRF ticket name (default: _csrf_id) csrf_post_only : CSRF protect runmode request method check(default:0 1:POST Only) Example: sub cgiapp_init { my $self = shift; $self->tmpl_path("/path/to/template"); $self->protect_csrf_config( csrf_error_status => 403, # change forbidden csrf_error_tmpl => "csrf_error.tmpl", csrf_error_tmpl_param => { TITLE => "CSRF ERROR", MESSAGE => "your access is csrf!"}, csrf_id => "ticket_id", csrf_post_only => 1 ); } # csrf_error.tmpl <TMPL_VAR NAME=TITLE ESCAPE=HTML>

CSRF Error

clear_csrf_id Clear csrfid. It is preferable to make it execute after processing ends. Example : sub cgiapp_init { my $self = shift; $self->protect_csrf_config; } sub input { my $self = shift; do_something(). # input form display.. } sub confirm : PublishCSRFID { my $self = shift; do_something(). # publish csrf_id and input check and confirm display.. } sub complete : ProtectCSRF { my $self = shift; $self->clear_csrf_id(1); # clear csrf_id for CSRF protect do_something(); # DB insert etc.. } CALLBACK _publish_csrf_id prerun callback _csrf_forbidden prerun callback _add_csrf_id postrun callback CAUTION It has only the protection function of basic CSRF,and mount other security checks in the application, please. SEE ALSO Attribute::Handlers Carp CGI::Application CGI::Application::Plugin::Session Digest::SHA1 Exporter HTML::TokeParser AUTHOR Akira Horimoto COPYRIGHT Copyright (C) 2006 - 2008 Akira Horimoto This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. CGI-Application-Plugin-ProtectCSRF-1.01/Build.PL0000444000076400007640000000122610737432612020100 0ustar adminadminuse strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'CGI::Application::Plugin::ProtectCSRF', license => 'perl', dist_author => 'Akira Horimoto ', dist_version_from => 'CGI/Application/Plugin/ProtectCSRF.pm', requires => { "Attribute::Handlers" => 0.78, "CGI::Application" => 4.04, "CGI::Application::Plugin::Session" => 1.01, "Digest::SHA1" => 2.07, }, add_to_cleanup => [ 'CGI-Application-Plugin-ProtectCSRF-*' ], ); $builder->create_build_script(); CGI-Application-Plugin-ProtectCSRF-1.01/META.yml0000444000076400007640000000072710737432612020062 0ustar adminadmin--- name: CGI-Application-Plugin-ProtectCSRF version: 1.01 author: - 'Akira Horimoto ' abstract: Plug-in protected from CSRF license: perl requires: Attribute::Handlers: 0.78 CGI::Application: 4.04 CGI::Application::Plugin::Session: 1.01 Digest::SHA1: 2.07 generated_by: Module::Build version 0.2808 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 resources: license: http://dev.perl.org/licenses/ CGI-Application-Plugin-ProtectCSRF-1.01/t/0000775000076400007640000000000010737432612017052 5ustar adminadminCGI-Application-Plugin-ProtectCSRF-1.01/t/pod.t0000444000076400007640000000026310737432612020016 0ustar adminadmin#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok("CGI/Application/Plugin/ProtectCSRF.pm"); CGI-Application-Plugin-ProtectCSRF-1.01/t/04.protect_csrf_error.t0000444000076400007640000000110310737432612023356 0ustar adminadminuse Test::More tests => 2; use lib qw(./t/lib); use CSRFApp::PublishCSRFTicket; open FILE, "<", "/tmp/cap-protect-csrf-test" or die $!; my $data = ; close FILE; my($csrf_id, $cookie) = split /\t/, $data; $ENV{HTTP_COOKIE} = $cookie; $ENV{REQUEST_METHOD} = "GET"; $ENV{QUERY_STRING} = "rm=finish&_csrf_id=$csrf_id"; $ENV{CGI_APP_RETURN_ONLY} = 1; my $output = CSRFApp::PublishCSRFTicket->new->run; unlike($output, qr/finish!/, "protect csrf error not finish"); like($output, qr/

your access is csrf!<\/h1>/, "protect csrf error"); unlink "/tmp/cap-protect-csrf-test"; CGI-Application-Plugin-ProtectCSRF-1.01/t/03.protect_csrf.t0000444000076400007640000000070210737432612022150 0ustar adminadminuse Test::More tests => 1; use lib qw(./t/lib); use CSRFApp::PublishCSRFTicket; open FILE, "<", "/tmp/cap-protect-csrf-test" or die $!; my $data = ; close FILE; my($csrf_id, $cookie) = split /\t/, $data; $ENV{HTTP_COOKIE} = $cookie; $ENV{REQUEST_METHOD} = "GET"; $ENV{QUERY_STRING} = "rm=finish&_csrf_id=$csrf_id"; $ENV{CGI_APP_RETURN_ONLY} = 1; my $output = CSRFApp::PublishCSRFTicket->new->run; like($output, qr/finish!/, "protect csrf"); CGI-Application-Plugin-ProtectCSRF-1.01/t/template/0000775000076400007640000000000010737432612020665 5ustar adminadminCGI-Application-Plugin-ProtectCSRF-1.01/t/template/csrf_error.tmpl0000444000076400007640000000016510737432612023727 0ustar adminadmin CSRF ERROR

CGI-Application-Plugin-ProtectCSRF-1.01/t/perlcritic.t0000444000076400007640000000035210737432612021373 0ustar adminadminuse Test::More; eval { require Test::Perl::Critic }; if ($@) { Test::More::plan( skip_all => "Test::Perl::Critic required for testing PBP compliance" ); } Test::Perl::Critic::all_critic_ok("CGI/Application/Plugin"); CGI-Application-Plugin-ProtectCSRF-1.01/t/02.publish_csrf_ticket.t0000444000076400007640000000074210737432612023504 0ustar adminadminuse Test::More tests => 1; use lib qw(./t/lib); use CSRFApp::PublishCSRFTicket; $ENV{CGI_APP_RETURN_ONLY} = 1; my $app = CSRFApp::PublishCSRFTicket->new; my $output = $app->run; like($output, qr//, "publish csrf ticket id"); my($cookie) = $output =~ /Set\-Cookie:\s+(CGISESSID=[a-z0-9]+;\s+path=\/)/; open FILE, ">", "/tmp/cap-protect-csrf-test" or die $!; print FILE join "\t", $app->csrf_id, $cookie; close FILE; CGI-Application-Plugin-ProtectCSRF-1.01/t/pod-coverage.t0000444000076400007640000000025410737432612021607 0ustar adminadmin#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); CGI-Application-Plugin-ProtectCSRF-1.01/t/lib/0000775000076400007640000000000010737432612017620 5ustar adminadminCGI-Application-Plugin-ProtectCSRF-1.01/t/lib/CSRFApp/0000775000076400007640000000000010737432612021016 5ustar adminadminCGI-Application-Plugin-ProtectCSRF-1.01/t/lib/CSRFApp/Base.pm0000444000076400007640000000130010737432612022214 0ustar adminadminpackage CSRFApp::Base; use base qw(CGI::Application); use strict; use warnings; use CGI::Application::Plugin::Session; use CGI::Application::Plugin::ProtectCSRF; use Cwd; use File::Spec; sub cgiapp_init { my $self = shift; $self->tmpl_path(File::Spec->catfile(getcwd, "t", "template")); $self->protect_csrf_config( csrf_error_tmpl => "csrf_error.tmpl", csrf_error_tmpl_param => { MESSAGE => "your access is csrf!" } ); } sub setup { my $self = shift; $self->start_mode("index"); $self->error_mode("error"); $self->mode_param("rm"); $self->run_modes( index => "index", finish => "finish" ); } sub error { my($self, $error) = @_; return "ERROR: $error"; } 1; CGI-Application-Plugin-ProtectCSRF-1.01/t/lib/CSRFApp/PublishCSRFTicket.pm0000444000076400007640000000060610737432612024602 0ustar adminadminpackage CSRFApp::PublishCSRFTicket; use base qw(CSRFApp::Base); use strict; use warnings; sub index : PublishCSRFID { my $self = shift; return qq{
}; } sub finish : ProtectCSRF { my $self = shift; $self->clear_csrf_id(1); return "finish!"; } 1; CGI-Application-Plugin-ProtectCSRF-1.01/t/00.load.t0000444000076400007640000000012310737432612020364 0ustar adminadminuse Test::More tests => 1; require_ok( 'CGI::Application::Plugin::ProtectCSRF' ); CGI-Application-Plugin-ProtectCSRF-1.01/t/01.csrf_error.t0000444000076400007640000000045610737432612021625 0ustar adminadminuse Test::More tests => 1; use lib qw(./t/lib); use CSRFApp::PublishCSRFTicket; $ENV{CGI_APP_RETURN_ONLY} = 1; $ENV{REQUEST_METHOD} = "GET"; $ENV{QUERY_STRING} = "rm=finish"; my $output = CSRFApp::PublishCSRFTicket->new->run; like($output, qr/

your access is csrf!<\/h1>/, "csrf error message"); CGI-Application-Plugin-ProtectCSRF-1.01/Makefile.PL0000444000076400007640000000137110737432612020557 0ustar adminadminuse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'CGI::Application::Plugin::ProtectCSRF', AUTHOR => 'Akira Horimoto ', VERSION_FROM => 'CGI/Application/Plugin/ProtectCSRF.pm', ABSTRACT_FROM => 'CGI/Application/Plugin/ProtectCSRF.pm', PL_FILES => {}, PREREQ_PM => { "Attribute::Handlers" => 0.78, "CGI::Application" => 4.04, "CGI::Application::Plugin::Session" => 1.01, "Digest::SHA1" => 2.07, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'CGI-Application-Plugin-ProtectCSRF-*' }, ); CGI-Application-Plugin-ProtectCSRF-1.01/Changes0000444000076400007640000000115310737432612020076 0ustar adminadminRevision history for Perl extension CGI::Application::Plugin::ProtectCSRF. 1.01 Thu Jan 04 22:32:00 2008 - fixed test script 1.00 Thu Jan 04 21:05:00 2008 - fixed all 0.02 Thu Nov 16 01:03:40 2006 - fixed prerun callback _csrf_forbidden (When runmode set with add_postonly_runmodes is requests other than POST, processing that does the access permission is added) - add add_postonly_runmodes(new method) - add delete_postonly_runmodes(new method) 0.01 Sun Nov 12 21:51:15 2006 - original version; created by h2xs 1.23 with options -AXn CGI::Application::Plugin::ProtectCSRF CGI-Application-Plugin-ProtectCSRF-1.01/MANIFEST0000444000076400007640000000047710737432612017744 0ustar adminadminBuild.PL CGI/Application/Plugin/ProtectCSRF.pm Changes MANIFEST Makefile.PL README t/00.load.t t/01.csrf_error.t t/02.publish_csrf_ticket.t t/03.protect_csrf.t t/04.protect_csrf_error.t t/lib/CSRFApp/Base.pm t/lib/CSRFApp/PublishCSRFTicket.pm t/perlcritic.t t/pod-coverage.t t/pod.t t/template/csrf_error.tmpl META.yml CGI-Application-Plugin-ProtectCSRF-1.01/CGI/0000775000076400007640000000000010737432612017211 5ustar adminadminCGI-Application-Plugin-ProtectCSRF-1.01/CGI/Application/0000775000076400007640000000000010737432612021454 5ustar adminadminCGI-Application-Plugin-ProtectCSRF-1.01/CGI/Application/Plugin/0000775000076400007640000000000010737432612022712 5ustar adminadminCGI-Application-Plugin-ProtectCSRF-1.01/CGI/Application/Plugin/ProtectCSRF.pm0000444000076400007640000002731110737432612025346 0ustar adminadminpackage CGI::Application::Plugin::ProtectCSRF; =pod =head1 NAME CGI::Application::Plugin::ProtectCSRF - Plug-in protected from CSRF =head1 VERSION 1.01 =head1 SYNPSIS use Your::App; use base qw(CGI::Application); use CGI::Application::Plugin::Session; # require!! use CGI::Application::Plugin::ProtectCSRF; sub input_form : PublishCSRFID { my $self = shift; do_something(); } sub finish : ProtectCSRF { my $self = shift; $self->clear_csrf_id; do_something(); } =head1 DESCRIPTION CGI::Application::Plugin::ProtectCSRF is C::A::P protected from CSRF. When CSRF is detected, Forbidden is returned and processing is interrupted. =cut use strict; use base qw(Exporter); use Carp; use HTML::TokeParser; use Digest::SHA1 qw(sha1_hex); use Attribute::Handlers; our( @EXPORT, $CSRF_ERROR_MODE, $CSRF_ERROR_STATUS, $CSRF_ERROR_TMPL, $CSRF_ID, $CSRF_ID_LENGTH, $CSRF_POST_ONLY, $VERSION ); @EXPORT = qw( clear_csrf_id csrf_id protect_csrf_config ); $CSRF_ERROR_MODE = "_csrf_error"; $CSRF_ERROR_STATUS = 200; $CSRF_ERROR_TMPL = \qq{ CSRF ERROR

CSRF ERROR

This access is illegal. you don't have permission to access on this server.

}; $CSRF_ID = "_csrf_id"; $CSRF_POST_ONLY = 0; $VERSION = 1.01; my(%publish_csrf_id_runmodes, %protect_csrf_runmodes); sub import { my $pkg = caller; # C::A::P::Session method check croak("C::A::P::Session module is not load to your app") if !$pkg->can("session"); $pkg->add_callback("prerun", \&_publish_csrf_id); $pkg->add_callback("prerun", \&_csrf_forbidden); $pkg->add_callback("postrun", \&_add_csrf_id); goto &Exporter::import; } =pod =head1 ACTION =head2 PublishCSRFID PublishCSRFID is action publishes CSRF ticket. CSRF ticket is published when I define it as an attribute of runmode method publishing CSRF ticket, and it is saved in session. If there is form tag in HTML to display after the processing end, as for runmode method to publish, CSRF ticket is set automatically by hidden field # publish CSRF ticket sub input_form : PublishCSRFID { my $self = shift; return < HTML } # display html source
<- insert hidden field
=head2 ProtectCSRF ProtectCSRF is action to protect from CSRF Attack. If session CSRF ticket does not accord with query CSRF ticket, application consideres it to be CSRF attack and refuse to access it. Carry out the processing that you want to perform after having carried out clear_csrf_id method when access it, and it was admitted. sub finish : ProtectCSRF { my $self = shift; $self->clear_csrf_id; # require! There is not a meaning unless I do it do_something(); # The processing that you want to perform (DB processing etc) } =cut sub CGI::Application::PublishCSRFID : ATTR(BEGIN) { my ($package, $symbol, $referent, $attr, $data, $phase) = @_; $publish_csrf_id_runmodes{$referent} = 1; #$publish_csrf_id_runmodes{*{$symbol}{NAME}} = 1; } sub CGI::Application::ProtectCSRF : ATTR(BEGIN) { my ($package, $symbol, $referent, $attr, $data, $phase) = @_; $protect_csrf_runmodes{$referent} = 1; } =pod =head1 METHOD =head2 csrf_id Get ticket for protect CSRF Example: sub input_form : PublishCSRFID { my $self = shift; my $csrf_id = $self->csrf_id; do_something(); } =cut sub csrf_id { my $self = shift; return $self->session->param($self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_id}); } =head2 protect_csrf_config Initialize ProtectCSRF Option: csrf_error_status : CSRF error status code (default: 200) csrf_error_mode : CSRF error runmode name (default: _csrf_error) csrf_error_tmpl : CSRF error display html. scalarref or filepath or filehandle (default: $CSRF_ERROR_TMPL - scalarref) csrf_error_tmpl_param : CSRF error display html parameter (for HTML::Template) csrf_id : CSRF ticket name (default: _csrf_id) csrf_post_only : CSRF protect runmode request method check(default:0 1:POST Only) Example: sub cgiapp_init { my $self = shift; $self->tmpl_path("/path/to/template"); $self->protect_csrf_config( csrf_error_status => 403, # change forbidden csrf_error_tmpl => "csrf_error.tmpl", csrf_error_tmpl_param => { TITLE => "CSRF ERROR", MESSAGE => "your access is csrf!"}, csrf_id => "ticket_id", csrf_post_only => 1 ); } # csrf_error.tmpl <TMPL_VAR NAME=TITLE ESCAPE=HTML>

CSRF Error

=cut sub protect_csrf_config { my($self, %args) = @_; if(ref($self->{__CAP_PROTECT_CSRF_CONFIG}) ne "HASH"){ $self->{__CAP_PROTECT_CSRF_CONFIG} = {}; } $self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_error_status} = exists $args{csrf_error_status} ? $args{csrf_error_status} : $CSRF_ERROR_STATUS; $self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_error_mode} = exists $args{csrf_error_mode} ? $args{csrf_error_mode} : $CSRF_ERROR_MODE; $self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_error_tmpl} = exists $args{csrf_error_tmpl} ? $args{csrf_error_tmpl} : $CSRF_ERROR_TMPL; $self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_error_tmpl_param} = {}; $self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_id} = exists $args{csrf_id} ? $args{csrf_id} : $CSRF_ID; $self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_post_only} = exists $args{csrf_post_only} ? $args{csrf_post_only} : $CSRF_POST_ONLY; if(ref($args{csrf_error_tmpl_param}) eq "HASH" && keys %{$args{csrf_error_tmpl_param}}){ $self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_error_tmpl_param} = $args{csrf_error_tmpl_param}; } } =pod =head2 clear_csrf_id Clear csrfid. It is preferable to make it execute after processing ends. Example : sub cgiapp_init { my $self = shift; $self->protect_csrf_config; } sub input { my $self = shift; do_something(). # input form display.. } sub confirm : PublishCSRFID { my $self = shift; do_something(). # publish csrf_id and input check and confirm display.. } sub complete : ProtectCSRF { my $self = shift; $self->clear_csrf_id(1); # clear csrf_id for CSRF protect do_something(); # DB insert etc.. } =cut sub clear_csrf_id { my($self, $fast) = @_; $self->session->clear($self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_id}); $self->session->flush if $fast; } =pod =head1 CALLBACK =head2 _publish_csrf_id prerun callback =cut sub _publish_csrf_id { my($self, $rm) = @_; return if !exists $publish_csrf_id_runmodes{$self->can($rm)}; if(ref($self->{__CAP_PROTECT_CSRF_CONFIG}) ne "HASH"){ $self->protect_csrf_config; } my @words = ('A'..'Z', 'a'..'z', 0..9, '/', '.'); my $salt = join "", @words[ map { sprintf( "%d", rand(scalar @words) ) } 1..2 ]; my $csrf_id = sha1_hex($salt . time . $$ . rand(10000)); $self->session->param($self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_id}, $csrf_id); } =pod =head2 _csrf_forbidden prerun callback =cut sub _csrf_forbidden { my($self, $rm) = @_; my $err_flg = 0; return if !exists $protect_csrf_runmodes{$self->can($rm)}; if(ref($self->{__CAP_PROTECT_CSRF_CONFIG}) ne "HASH"){ $self->protect_csrf_config; } if($self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_post_only} && $ENV{REQUEST_METHOD} ne "POST"){ $err_flg = 1; } else { if( !$self->query->param($self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_id}) || !$self->csrf_id || $self->query->param($self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_id}) ne $self->csrf_id ){ $err_flg = 1; } } if($err_flg){ $self->run_modes( $self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_error_mode} => sub { my $self = shift; $self->header_props( -type => "text/html", -status => $self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_error_status} ); my $tmpl_obj = $self->load_tmpl($self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_error_tmpl}, die_on_bad_params => 0); if(keys %{$self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_error_tmpl_param}}){ $tmpl_obj->param(%{$self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_error_tmpl_param}}); } return $tmpl_obj->output; }); $self->prerun_mode($self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_error_mode}); } return 0; } =pod =head2 _add_csrf_id postrun callback =cut sub _add_csrf_id { my($self, $scalarref) = @_; my $rm = $self->get_current_runmode; my $coderef = $self->can($rm); return if !$coderef || !exists $publish_csrf_id_runmodes{$coderef}; if(ref($self->{__CAP_PROTECT_CSRF_CONFIG}) ne "HASH"){ $self->protect_csrf_config; } # my %header = $self->header_props; # return if %header && $header{-type} ne "text/html"; my $body = ""; my $hidden = sprintf qq{}, $self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_id}, $self->csrf_id; my $parser = HTML::TokeParser->new($scalarref); while(my $token = $parser->get_token){ # start tag(
sniping) if($token->[0] eq "S"){ if(lc($token->[1]) eq "form"){ $body .= $token->[4] . "\n" . $hidden; # In the future... #}elsif(lc($token->[1]) eq "a"){ # # if(exists $token->[2]->{href} && defined $token->[2]->{href}){ # my $uri = URI->new($token->[2]->{href}); # my %query_form = $uri->query_form; # $query_form{$self->{__CAP_PROTECT_CSRF_CONFIG}->{csrf_id}} = $self->csrf_id; # $uri->query_form(%query_form); # $token->[2]->{href} = $uri->path_query; # my $prop = join " ", (map { $_ . "=\"" . $token->[2]->{$_} . "\"" } keys %{$token->[2]}); # $body .= "<" . lc($token->[1]) . " ". $prop . ">"; # }else{ # $body .= $token->[4]; # } }else{ $body .= $token->[4]; } # end tag, process instructions }elsif($token->[0] =~ /^(E|PI)$/){ $body .= $token->[2]; # text, comment, declaration }elsif($token->[0] =~ /^(T|C|D)$/){ $body .= $token->[1]; } } ${$scalarref} = $body; } 1; __END__ =head1 CAUTION It has only the protection function of basic CSRF,and mount other security checks in the application, please. =head1 SEE ALSO L L L L L L L =head1 AUTHOR Akira Horimoto =head1 COPYRIGHT Copyright (C) 2006 - 2008 Akira Horimoto This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut