=pod
=head1 NAME
CGI::Application::Plugin::ProtectCSRF - Plug-in protected from CSRF
=head1 VERSION
0.02
=head1 SYSNPSIS
use Your::App;
use CGI::Application::Plugin::Session; # require!!
use CGI::Application::Plugin::ProtectCSRF;
=head1 DESCRIPTION
CGI::Application::Plugin::ProtectCSRF is C::A::P protected from CSRF.
When CSRF is detected, 403 Forbidden is returned and processing is interrupted.
=cut
use strict;
use base qw(Exporter);
use Carp;
use List::Util qw(shuffle);
our(
@EXPORT,
$CSRFID,
$FORBIDDEN_BODY,
$FORBIDDEN_CODE,
$FORBIDDEN_MODE,
$VERSION
);
@EXPORT = qw(clear_csrfid is_post_request add_postonly_runmodes delete_postonly_runmodes);
$CSRFID = "_csrfid";
$FORBIDDEN_CODE = ($ENV{MOD_PERL}) ? 200 : 403;
$FORBIDDEN_BODY = <<FORBIDDEN;
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>Forbidden</title>
</head><body>
<h1>Forbidden</h1>
<p>You don't have permission to access on this server.</p>
</body></html>
FORBIDDEN
$FORBIDDEN_MODE = "_access_403_forbidden";
$VERSION = 0.02;
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", \&_create_csrfid);
$pkg->add_callback("prerun", \&_csrf_forbidden);
$pkg->add_callback("postrun", \&_add_csrfid);
goto &Exporter::import;
}
=pod
=head1 METHOD
=head2 add_postonly_runmodes
Runmodes set to runmodes returns add_postonly_runmodes "Forbidden" excluding POST Request.
Example :
sub setup { # or cgiapp_init
my $self = shift;
....
# When requests other than POST come to mode1, mode2, and mode3, Forbidden is
# returned.
$self->add_postonly_runmodes(qw(mode1 mode2 mode3));
}
=cut
sub add_postonly_runmodes {
my($self, @runmodes) = @_;
if(ref($self->{__CAP_PROTECT_CSRF_CONFIG}->{POSTONLY_RUNMODES}) ne "HASH"){
$self->{__CAP_PROTECT_CSRF_CONFIG}->{POSTONLY_RUNMODES} = {};
}
map { $self->{__CAP_PROTECT_CSRF_CONFIG}->{POSTONLY_RUNMODES}->{$_} = 1 } @runmodes;
}
=pod
=head2 delete_postonly_runmodes
To cancel runmode set with add_postonly_runmodes, it executes it.
Example :
$self->delete_postonly_runmodes(qw(mode1 mode2 mode3));
=cut
sub delete_postonly_runmodes {
my($self, @runmodes) = @_;
if(ref($self->{__CAP_PROTECT_CSRF_CONFIG}->{POSTONLY_RUNMODES}) ne "HASH"){
$self->{__CAP_PROTECT_CSRF_CONFIG}->{POSTONLY_RUNMODES} = {};
return;
}
map {
if(exists $self->{__CAP_PROTECT_CSRF_CONFIG}->{POSTONLY_RUNMODES}->{$_}){
delete $self->{__CAP_PROTECT_CSRF_CONFIG}->{POSTONLY_RUNMODES}->{$_};
}
} @runmodes;
}
=pod
=head2 clear_csrfid
Clear csrfid. It is preferable to make it execute after processing ends.
Input screen => confirmation screen => completion screen(here!!)
Example :
sub input {
my $self = shift;
....
}
sub confirm {
my $self = shift;
....
}
sub complete {
my $self = shift;
...process start(DB insert etc..)
$self->clear_csrfid;
....
}
=cut
sub clear_csrfid {
my($self, $fast) = @_;
$self->session->clear($CSRFID);
$self->session->flush if $fast;
}
=pod
=head2 is_post_request
Check request method.If request method is POST, 1 is returned.
Example :
my $post_flag;
if($self->is_post_request){
# $self->query->request_method or $ENV{REQUEST_METHOD} is POST
}else{
# not POST
}
=cut
sub is_post_request {
my $self = shift;
return ($self->query->request_method eq "POST") ? 1 : 0;
}
# ============================================================= #
# =================== add_callback "prerun" =================== #
# ============================================================= #
sub _create_csrfid {
my $self = shift;
if(!$self->session->param($CSRFID)){
my $rnd_str = join "", shuffle(split //, $self->session->id);
my $sha1 = Digest::SHA1->new;
$sha1->add($rnd_str);
$self->session->param($CSRFID, $sha1->hexdigest);
}
}
# ============================================================= #
# =================== add_callback "prerun" =================== #
# ============================================================= #
sub _csrf_forbidden {
my($self, $rm) = @_;
my $err_flg = 0;
# request method : POST only
if($self->is_post_request){
if(
!$self->query->param($CSRFID) ||
!$self->session->param($CSRFID) ||
$self->query->param($CSRFID) ne $self->session->param($CSRFID)
){
$err_flg = 1;
}
}else{
# postonly runmode check
if(
ref($self->{__CAP_PROTECT_CSRF_CONFIG}->{POSTONLY_RUNMODES}) eq "HASH" &&
exists $self->{__CAP_PROTECT_CSRF_CONFIG}->{POSTONLY_RUNMODES}->{$rm}
){
$err_flg = 1;
}
}
if($err_flg){
$self->run_modes( $FORBIDDEN_MODE => sub {
my $self = shift;
$self->header_props(
-type => "text/html",
-status => $FORBIDDEN_CODE,
);
return $FORBIDDEN_BODY;
});
$self->prerun_mode($FORBIDDEN_MODE);
}
return 0;
}
# ============================================================= #
# ================== add_callback "postrun" =================== #
# ============================================================= #
sub _add_csrfid {
my($self, $scalarref) = @_;
# text/html is target
my %header = $self->header_props;
# return if %header && $header{-type} ne "text/html";
my $body = undef;
my $hidden = sprintf "<input type=\"hidden\" name=\"%s\" value=\"%s\" />", $CSRFID, $self->session->param($CSRFID);
my $parser = HTML::TokeParser->new($scalarref);
while(my $token = $parser->get_token){
# start tag(<form> sniping)
if($token->[0] eq "S"){
if(lc($token->[1]) eq "form"){
$body .= $token->[4] . "\n" . $hidden;
}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<Carp> L<CGI::Application> L<CGI::Application::Plugin::Session> L<Exporter> L<Digest::SHA1> L<HTML::TokeParser> L<List::Util>
=head1 AUTHOR
Akira Horimoto <kurt0027@gmail.com>
=head1 COPYRIGHT
Copyright (C) 2006 Akira Horimoto
This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut