diff --git a/Changes b/Changes index d7b00ad..d1474a9 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,7 @@ Revision history for CGI-Info 0.86 Ensure correct message is logged on SQL injection attempt + Remember warnings in the warnings array - added warnings() method 0.85 Sun Nov 17 09:49:52 EST 2024 Send back HTTP code 422 when argument fails "allow" diff --git a/lib/CGI/Info.pm b/lib/CGI/Info.pm index 2508232..53e3cfd 100644 --- a/lib/CGI/Info.pm +++ b/lib/CGI/Info.pm @@ -863,6 +863,8 @@ sub _warn { } # return if($self eq __PACKAGE__); # Called from class method + push @{$self->{'warnings'}}, { warning => $warning }; + if($self->{syslog}) { require Sys::Syslog; @@ -1737,6 +1739,19 @@ sub status return $self->{status} || 200; } +=head2 warnings + +Returns the warnings that the object has generated + +=cut + +sub warnings +{ + my $self = shift; + + return $self->{'warnings'}; +} + =head2 set_logger Sometimes you don't know what the logger is until you've instantiated the class. diff --git a/t/param.t b/t/param.t index 6063d51..9f553c5 100644 --- a/t/param.t +++ b/t/param.t @@ -2,7 +2,7 @@ use strict; use warnings; -use Test::Most tests => 33; +use Test::Most tests => 40; use Test::NoWarnings; use lib 't/lib'; use MyLogger; @@ -12,6 +12,48 @@ BEGIN { } PARAM: { + # Initial sanity tests + { + # Preserve the current %ENV, so changes are local to this subtest + local %ENV = %ENV; + + $ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1'; + $ENV{'REQUEST_METHOD'} = 'GET'; + $ENV{'QUERY_STRING'} = 'foo=bar&baz=qux'; + my $mess = 'mess is undefined'; + + { + package MockLogger; + + sub new { bless { }, shift } + sub trace { } + sub debug { } + sub warn { shift; $mess = join(' ' , @_) } + } + + my $obj = CGI::Info->new( + allow => { foo => undef, baz => undef }, + logger => MockLogger->new() + ); + + is_deeply($obj->param, { foo => 'bar', baz => 'qux' }, 'No arguments returns all params'); + + is($obj->param('foo'), 'bar', 'Fetching allowed parameter "foo"'); + + is($obj->param('baz'), 'qux', 'Fetching allowed parameter "baz"'); + + is($obj->param('invalid'), undef, 'Fetching disallowed parameter "invalid" returns undef'); + like( + $obj->warnings()->[0]->{'warning'}, + qr/param: invalid isn't in the allow list/, + 'Warning generated for disallowed parameter' + ); + + delete $ENV{'QUERY_STRING'}; + $obj = CGI::Info->new(); + is($obj->param('foo'), undef, 'No params set, fetching "foo" returns undef'); + }; + $ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1'; $ENV{'REQUEST_METHOD'} = 'GET'; $ENV{'QUERY_STRING'} = 'foo=bar'; @@ -66,6 +108,18 @@ PARAM: { ok($i->param('fred') eq 'wilma'); ok($i->as_string() eq 'foo=bar;fred=wilma'); + subtest 'SQL injection is blocked' => sub { + # Preserve the current %ENV, so changes are local to this subtest + local %ENV = %ENV; + + $ENV{'REQUEST_METHOD'} = 'GET'; + $ENV{'QUERY_STRING'} = 'nan=lost&redir=-8717%22%20OR%208224%3D6013--%20ETLn'; + + my $info = new_ok('CGI::Info'); + ok(!defined($info->param('nan'))); + ok(!defined($info->param('redir'))); + }; + subtest 'Test GET' => sub { # Preserve the current %ENV, so changes are local to this subtest local %ENV = %ENV; @@ -101,5 +155,6 @@ PARAM: { is($info->name(), 'Jane', 'name parameter is correct with AUTOLOAD'); close $fh - } + }; + } diff --git a/t/params.t b/t/params.t index 0f16867..7befb41 100644 --- a/t/params.t +++ b/t/params.t @@ -517,7 +517,7 @@ EOF sub warn { shift; $mess = join(' ' , @_) } } - my $info = new_ok('CGI::Info' => ); + my $info = new_ok('CGI::Info'); my $params = $info->params(logger => MockLogger->new()); like($mess, qr/SQL injection attempt blocked/, 'Correct message when blocking SQL injection');