• Files
• Commits
• Log
• Graph
• Stats

package Local::Dancer2::CSRF;

# port of Dancer2::Plugin::CSRF

# Dancer2::Plugin::CSRF doesn't work well with DP::Deferred which appends
# '?dpdid=.....' to form submission which breaks token validation, it also
# uses deprecated dsl keywords (eg request->dispatch_path)

use Crypt::SaltedHash;
use Dancer2::Plugin;
use Data::Printer;
use Modern::Perl;
use Data::UUID;

my $HASHER = Crypt::SaltedHash->new( algorithm => 'SHA-1' ); # SHA1 is default anyway
my $UUID   = Data::UUID->new();

plugin_keywords qw( get_csrf_token check_csrf_token );

has session_key_name => (
    is      => 'ro', # this plugin config session_key_name if set:
    default => sub { $_[0]->config->{session_key_name} || 'csrf_token' }
);

sub get_csrf_token {
    my $self = shift;

    my $app = $self->app; # p $app->session;

    my $key_name = $self->session_key_name;    # p $key_name;
    my $session  = $app->session;              # p $session;

    # create a session $key_name => value pair if it doesn't exist:
    unless ( $session->read($key_name) ) {
        my $str = $UUID->create_str(); # p $ref;
        $session->write( $key_name => $str );
    } # p $session;
    # generate a new token:
    my $token = $self->_generate_token; # p $token;
    return $token;
}

# check whether submitted form token matches its expected value, then delete
# csrf key value from session to block back-button resubmission:
sub check_csrf_token {
    my ($self, $form_token) = @_; # p $form_token;

    # generate expected token (using same function as original form) for
    # comparison with $form_token (return a failure if no session key):
    my $expected_token = $self->_generate_token || return 0; # p $expected_token;

    # clear csrf-token from session to prevent back-button resubmission:
    my $key_name = $self->session_key_name;    # p $key_name;
    $self->app->session->delete($key_name);

    # returns boolen truth:
    return $form_token eq $expected_token;
}

# generate a salted-hash token using session $key_name value & form_url value:
sub _generate_token {
    my $self = shift;

    my $app = $self->app;

    my $session_key_name  = $self->session_key_name; # p $session_key_name;
    my $session_key_value = $app->session->read($session_key_name) || return 0; # p $session_key_value;
=begin
p $app->request->path;         # eg "/upload"
p $app->request->request_uri;  # eg "/upload?dpdid=59091261"
p $app->request->base;         # URI::http object, stringifies to "http://localhost:3000/"
p $app->request->uri_base;     # eg "http://localhost:3000"
=cut
    my $request  = $app->request;
    # this needs to work for both initial get & associated post requests:
    # my $form_url = do {
    #    ( my $path = $request->path ) =~ s{^/}{}; # p $path;
    #    $request->base . $path;
    # };
    my $form_url = $request->uri_base . $request->path; # p $form_url;

    my $token = $HASHER->add($session_key_value, $form_url)->generate(); # p $token;
    $HASHER->clear();
    return $token
}

1;