view release on metacpan or  search on metacpan

lib/Ark/Plugin/CSRFDefender.pm  view on Meta::CPAN

    isa => 'Str',
    lazy => 1,
    default => sub {
        shift->class_config->{error_action} || '';
    }
);

has csrf_defender_filter_form => (
    is      => 'ro',
    isa     => 'Bool',
    lazy    => 1,
    default => sub {
        shift->class_config->{filter_form} || undef;
    },
);

my $uuid = Data::UUID->new;
has csrf_token => (
    is     => 'ro',
    isa    => 'Str',
    lazy   => 1,
    default => sub {
        my $c = shift;

        if (my $token = $c->session->get($c->csrf_defender_session_name)) {
            return $token;
        }
        else {
            my $token = $uuid->create_str;
            $c->session->set($c->csrf_defender_session_name => $token);

            return $token;
        }
    },
    predicate => '_has_csrf_token',
);

sub validate_csrf_token {
    my $c = shift;
    my $req = $c->request;
    if ($c->_is_csrf_validation_needed) {
        my $param_token   = $req->param($c->csrf_defender_param_name);
        my $session_token = $c->csrf_token;
        if (!$param_token || !$session_token || ($param_token ne $session_token)) {
            return (); # bad
        }
    }
    return 1; # good
}

sub forward_csrf_error {
    my $c = shift;

    if ($c->csrf_defender_error_action) {
        $c->res->code($c->csrf_defender_error_code);
        $c->forward($c->csrf_defender_error_action);
    }
    else {
        $c->res->code($c->csrf_defender_error_code);
        $c->res->body($c->csrf_defender_error_output);
        $c->res->header('Content-Type', 'text/html; charset=UTF-8');
    }
}

sub _is_csrf_validation_needed {
    my $c = shift;
    my $method = $c->req->method;
    return () if !$method;

    return
        $method eq 'POST'   ? 1 :
        $method eq 'PUT'    ? 1 :
        $method eq 'DELETE' ? 1 : ();
}

sub html_filter_for_csrf {
    my ($c, $html) = @_;

    my $reg = qr/<form\s*.*?\s*method=['"]?post['"]?\s*.*?>/i;
    $html =~ s!($reg)!$1\n<input type="hidden" name="@{[$c->csrf_defender_param_name]}" value="@{[$c->csrf_token]}" />!isg;

    $html;
}

after finalize_body => sub {
    my $c = shift;

    return if $c->res->binary;
    my $html = $c->res->body or return;
    return unless $c->csrf_defender_filter_form;

    $html = $c->html_filter_for_csrf($html);
    $c->res->body($html);
};

around dispatch => sub {
    my $orig = shift;
    my ($c) = @_;

    # surely asign csrf_token
    $c->csrf_token;
    if (!$c->csrf_defender_validate_only && !$c->validate_csrf_token) {
        $c->forward_csrf_error;
    }
    else {
        $orig->(@_);
    }
};

1;
__END__

=encoding utf-8

=head1 NAME

Ark::Plugin::CSRFDefender - CSRF Defender for Ark

=head1 SYNOPSIS

    use Ark::Plugin::CSRFDefender;