package CGI::Application::Plugin::ProtectCSRF; =pod =head1 NAME CGI::Application::Plugin::ProtectCSRF - generate and verify anti-CSRF tickets =head1 VERSION 1.01 =head1 SYNPSIS use Your::App; use base qw(CGI::Application); use CGI::Application::Plugin::Session; # mandatory !! 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 provides tools to protect forms in L web applications from CSRF attacks. Run mode handlers may be declared with the C or C attributes. The former should usually be applied to a run mode, whose HTML includes a C
tag. In this case a ticket is generated and stored in the session during a prerun callback and a C control field, publishing the ticket, is added to the form during a postrun callback. Conversely the C attribute should normally be applied to the corresponding run modes that process data from a submitted form. A prerun callback checks for the hidden field and checks that it matches the ticket saved in the session. If the check fails the page is redirected to a customizable error page. On success the form processing run mode should use the C method, so that subsequent calls to forms from that session will generate fresh tickets. =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

Access denied. Please contact the website administrator.

}; $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("CGI::Aplication::Plugin::Session module is not loaded in 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 Run modes declared with the C attribute, take the following actions: =over =item - generate CSRF ticket and store it in the session; =item - generate the form as per the module code; =item - add a hidden element to the form publishing the CSRF ticket. =back # publish CSRF ticket sub input_form : PublishCSRFID { my $self = shift; return < HTML } # display html source
<- insert hidden field
=head2 ProtectCSRF Run modes declared with the C attribute, take the following actions: =over =item - verify that the submitted CSRF ticket matches the ticket saved in the session. If there is any sort of issue with the ticket the page is redirected to a customizable error page; =item - the form is processed as per the module code; =item - the form should call the C method so that subsequent forms generate fresh tickets. The code does not do this because if the form validation fails it might be best to retain the same ticket. =back sub finish : ProtectCSRF { my $self = shift; # required! Unless forms and their processing are tightly # coupled by clearing the ticket between invocations, # the meaning of the ticket is lost. $self->clear_csrf_id; # The processing that you want to perform (DB processing etc) do_something(); } =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 This method returns the CSRF ticket saved in the session. 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 This method initializes the ProtectCSRF state using any configuration options that were passed to it. The available options are: =over =item B - The HTTP status code that would be set on the CSRF error page if a CSRF attack is identified. It defaults to 200. =item B - The L runmode name. This defaults to C<_csrf_error>. =for comment The Debian maintainer is unclear why this option is useful. Surely an anonymous run mode would be cleaner here. =end comment =item B - The HTML displayed in the event of a CSRF attack being detected in the form of a scalarref or filepath or filehandle. One may consider L for inspiration on thse formats. The default is C<$CSRF_ERROR_TMPL> which is a scalarref. =item B - A hashref of parameters to be placed in the above template. See L. =for comment The Debian maintainer thinks other templating systems should work but is unlikely to experiment with this in the near future. =end comment =item B - The name of the session parameter used to store the CSRF ticket.This defaults to C<_csrf_id>. =item B - If set non-POST requests to a run mode which is protected by this module would be rejected. By default this is 0. =back 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 This method clears the CSFR ticket. This should be done during the processing of a form request. 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 This module should not be seen as a panacea for all web security issues. The user should fully understand and act on all security threats his application may face, including whether this module is an adequate and useful tool. =head1 SEE ALSO L, 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