Lines 18-25
package Koha::Middleware::CSRF;
Link Here
|
18 |
use Modern::Perl; |
18 |
use Modern::Perl; |
19 |
|
19 |
|
20 |
use parent qw(Plack::Middleware); |
20 |
use parent qw(Plack::Middleware); |
21 |
|
21 |
use Plack::Response; |
22 |
use Koha::Logger; |
|
|
23 |
|
22 |
|
24 |
sub call { |
23 |
sub call { |
25 |
my ( $self, $env ) = @_; |
24 |
my ( $self, $env ) = @_; |
Lines 41-47
sub call {
Link Here
|
41 |
|
40 |
|
42 |
my $original_op = $req->param('op'); |
41 |
my $original_op = $req->param('op'); |
43 |
my $request_method = $req->method // q{}; |
42 |
my $request_method = $req->method // q{}; |
44 |
my ( $error ); |
43 |
my ($error); |
45 |
if ( $stateless_methods{$request_method} && defined $original_op && $original_op =~ m{^cud-} ) { |
44 |
if ( $stateless_methods{$request_method} && defined $original_op && $original_op =~ m{^cud-} ) { |
46 |
$error = sprintf "Programming error - op '%s' must not start with 'cud-' for %s", $original_op, |
45 |
$error = sprintf "Programming error - op '%s' must not start with 'cud-' for %s", $original_op, |
47 |
$request_method; |
46 |
$request_method; |
Lines 70-79
sub call {
Link Here
|
70 |
} |
69 |
} |
71 |
} |
70 |
} |
72 |
|
71 |
|
73 |
if ( $error ) { |
72 |
if ( $error && !$env->{'plack.middleware.Koha.CSRF'} ) { |
74 |
Koha::Logger->get->warn( $error ); |
73 |
|
75 |
$env->{KOHA_ERROR} = $error; |
74 |
#NOTE: Other Middleware will take care of logging to correct place, as Koha::Logger doesn't know where to go here |
76 |
$env->{PATH_INFO} = '/intranet/errors/403.pl'; |
75 |
warn $error; |
|
|
76 |
$env->{'plack.middleware.Koha.CSRF'} = "BAD_CSRF"; |
77 |
my $res = Plack::Response->new( 403, [ 'Content-Type' => 'text/plain' ], ["Bad CSRF"] ); |
78 |
return $res->finalize; |
77 |
} |
79 |
} |
78 |
|
80 |
|
79 |
return $self->app->($env); |
81 |
return $self->app->($env); |