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
;
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
;
}
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
;
}
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
;
}
sub
clear_csrfid {
my
(
$self
,
$fast
) =
@_
;
$self
->session->clear(
$CSRFID
);
$self
->session->flush
if
$fast
;
}
sub
is_post_request {
my
$self
=
shift
;
return
(
$self
->query->request_method eq
"POST"
) ? 1 : 0;
}
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);
}
}
sub
_csrf_forbidden {
my
(
$self
,
$rm
) =
@_
;
my
$err_flg
= 0;
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
{
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;
}
sub
_add_csrfid {
my
(
$self
,
$scalarref
) =
@_
;
my
%header
=
$self
->header_props;
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){
if
(
$token
->[0] eq
"S"
){
if
(
lc
(
$token
->[1]) eq
"form"
){
$body
.=
$token
->[4] .
"\n"
.
$hidden
;
}
else
{
$body
.=
$token
->[4];
}
}
elsif
(
$token
->[0] =~ /^(E|PI)$/){
$body
.=
$token
->[2];
}
elsif
(
$token
->[0] =~ /^(T|C|D)$/){
$body
.=
$token
->[1];
}
}
${
$scalarref
} =
$body
;
}
1;