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 5.26.0; use Crypt::SaltedHash; use Dancer2::Plugin; use Data::Printer; 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;